home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d3456 / gmprintsuite_eval.exe / {app} / GmPreview.pas < prev    next >
Pascal/Delphi Source File  |  2002-01-09  |  149KB  |  4,729 lines
  1. {******************************************************************************}
  2. {                                                                              }
  3. {                            TGmPreview  2.3                                   }
  4. {                                                                              }
  5. {           Copyright (c) 2001 Graham Murt  - www.MurtSoft.com                 }
  6. {                                                                              }
  7. {   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
  8. {                                                                              }
  9. {                           graham@murtsoft.com                                }
  10. {                                                                              }
  11. {******************************************************************************}
  12.  
  13. unit GmPreview;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, GmObjects,
  19.   GmTypes, GmConst, GmStream, Dialogs;
  20.  
  21. const
  22.   // cursor values...
  23.   crZoomIn   = 101;
  24.   crZoomOut  = 102;
  25.   DEFAULT_ZOOM = 20;
  26.  
  27. type
  28.   // *** General Types ***
  29.  
  30.   TGmPaperSize = (A3, A4, A5, A6, B5, C5, Legal, Letter, Custom);
  31.  
  32.   TGmCoordsRelative   = (fromPage, fromPrinterMargins, fromUserMargins, fromHeaderLine);
  33.   TGmCursor           = (gmDefault, gmZoomIn, gmZoomOut);
  34.   TGmDuplexType       = (gmSimplex, gmHorzDuplex, gmVertDuplex);
  35.   TGmUserAction       = (None, LeftButton, RightButton);
  36.   TGmMeasurement      = (GmUnits, GmPixels, GmMillimeters, GmCentimeters, GmInches);
  37.   TGmOrientation      = (gmPortrait, gmLandscape);
  38.   TGmOrientationType  = (gmPortraitReport, gmLandscapeReport, gmMixedOrientation);
  39.   TGmPagesPerSheet    = (gmOnePage, gmTwoPage, gmFourPage);
  40.   TGmPrintColor       = (gmColor, gmMonochrome);
  41.   TGmPrintQuality     = (gmDraft, gmLow, gmMedium, gmHigh);
  42.   TGmDitherType       = (gmNone, gmCourse, gmFine, gmLineArt, gmGrayScale);
  43.   TGmVertAlignment    = (gmTop, gmMiddle, gmBottom);
  44.   TGmZoomStyle        = (gmFixedZoom, gmVariableZoom);
  45.  
  46.   TGmValue = class;
  47.   TGmPage = class;
  48.   TGmPrinter = class;
  49.  
  50.   // *** Events ***
  51.  
  52.   TBeforeLoadEvent        = procedure(Sender: TObject; FileVersion: Extended; var LoadFile: Boolean) of object;
  53.   TBeforePrintPage        = procedure(Sender: TObject; APage: TGmPage; PrinterHandle: THandle) of object;
  54.   TBeforeWriteStream      = procedure(Sender: TObject; FileStream: TStream) of object;
  55.   TBeforeReadStream       = procedure(Sender: TObject; FileStream: TStream) of object;
  56.   TFileProgressEvent      = procedure(Sender: TObject; Percent: Integer) of object;
  57.   TOnPageChangeEvent      = procedure(Sender: TObject; PageNum: integer) of object;
  58.   TOnPrintProgressEvent   = procedure(Sender: TObject; Printed, Total: integer) of object;
  59.   TOnZoomEvent            = procedure(Sender: TObject; OldZoom, NewZoom: integer) of object;
  60.   TPageMouseEvent         = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: TGmValue) of object;
  61.   TPageMouseMoveEvent     = procedure(Sender: TObject; Shift: TShiftState; X, Y: TGmValue) of object;
  62.   TPageOrientationChanged = procedure(Sender: TObject; PageNum: integer; NewOrientation: TGmOrientation) of object;
  63.  
  64.   // *** Forward declarations ***
  65.   TGmPreview = class;
  66.  
  67.  
  68.  
  69.   // *** TGmValue ***
  70.  
  71.   TGmValue = class
  72.   private
  73.     FValue: Integer; // (GmUnits)
  74.     FOnChange: TNotifyEvent;
  75.     procedure SetAsPixels(Ppi: integer; AValue: Integer);
  76.     procedure SetAsMm(AValue: Extended);
  77.     procedure SetAsCm(AValue: Extended);
  78.     procedure SetAsInches(AValue: Extended);
  79.  
  80.     function GetAsPixels(Ppi: integer): Integer;
  81.     function GetAsMm: Extended;
  82.     function GetAsCm: Extended;
  83.     function GetAsInches: Extended;
  84.   public
  85.     constructor Create;
  86.     property AsUnits: Integer read FValue write FValue;
  87.     property AsMillimeters: Extended read GetAsMm write SetAsMm;
  88.     property AsCentimeters: Extended read GetAsCm write SetAsCm;
  89.     property AsInches: Extended read GetAsInches write SetAsInches;
  90.     property AsPixels[index: integer]: Integer read GetAsPixels write SetAsPixels;
  91.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  92.   end;
  93.  
  94.   TGmValueRect = class
  95.   private
  96.     FLeft  : TGmValue;
  97.     FTop   : TGmValue;
  98.     FRight : TGmValue;
  99.     FBottom: TGmValue;
  100.   public
  101.     constructor Create;
  102.     destructor Destroy; override;
  103.     property Left: TGmValue read FLeft write FLeft;
  104.     property Top: TGmValue read FTop write FTop;
  105.     property Right: TGmValue read FRight write FRight;
  106.     property Bottom: TGmValue read FBottom write FBottom;
  107.   end;
  108.  
  109.  
  110.   // *** TGmPrinter ***
  111.  
  112.   TGmPrinter = class(TPersistent)
  113.   private
  114.     FPrinterBins   : TStringList;
  115.     FPrinterNames  : TStringList;
  116.     FPrinting      : Boolean;
  117.     FPreview       : TGmPreview;
  118.     FPrinterMargins: TGmValueRect;
  119.     FShowServer: Boolean;
  120.     FValue: TGmValue;
  121.     function GetCanvas: TCanvas;
  122.     function GetDitherType: TGmDitherType;
  123.     function GetDuplexType: TGmDuplexType;
  124.     function GetIndexOf(APrinter: string): integer;
  125.     function GetIsColorPrinter: Boolean;
  126.     function GetPrintColorMode: TGmPrintColor;
  127.     function GetPrinterIndex: integer;
  128.     function GetPrinters: TStrings;
  129.     function GetOffset: TPoint;
  130.     function GetOrientation: TGmOrientation;
  131.     function GetPrinterBins: TStrings;
  132.     function GetPrinterBinIndex: integer;
  133.     function GetPrinterInstalled: Boolean;
  134.     function GetPrinterMargin(index: integer): TGmValue;
  135.     function GetPrinterSelected: Boolean;
  136.     function GetTitle: string;
  137.     procedure SetDitherType(ADitherType: TGmDitherType);
  138.     procedure SetDuplexType(ADuplexType: TGmDuplexType);
  139.     procedure SetOrientation(AOrientation: TGmOrientation);
  140.     procedure SetPrinterColorMode(AColor: TGmPrintColor);
  141.     procedure SetPrinterIndex(index: integer);
  142.     procedure SetPrinterBinIndex(index: integer);
  143.     procedure SetPrintQuality(AQuality: TGmPrintQuality);
  144.     procedure SetShowServer(AValue: Boolean);
  145.     procedure SetTitle(ATitle: string);
  146.     procedure UpdatePrinterMargins;
  147.     function GetPrinterAvailableHeight: TGmValue;
  148.     function GetPrinterAvailableWidth: TGmValue;
  149.     function GetPrinterHeight: TGmValue;
  150.     function GetPrinterWidth: TGmValue;
  151.     function GetPrintQuality: TGmPrintQuality;
  152.   public
  153.     constructor Create(AOwner: TGmPreview);
  154.     destructor Destroy; override;
  155.     procedure Abort;
  156.     procedure BeginDoc(AFileName: string);
  157.     procedure EndDoc;
  158.     function GetHandle:  THandle;
  159.     property PrinterWidth: TGmValue read GetPrinterWidth;
  160.     property PrinterHeight: TGmValue read GetPrinterHeight;
  161.     property AvailableWidth: TGmValue read GetPrinterAvailableWidth;
  162.     property AvailableHeight: TGmValue read GetPrinterAvailableHeight;
  163.     function PrinterPpiX: integer;
  164.     function PrinterPpiY: integer;
  165.     procedure NewPage(Orientation: TGmOrientation);
  166.     procedure ResetPrinter;
  167.     property Canvas: TCanvas read GetCanvas;
  168.     property IsColorPrinter: Boolean read GetIsColorPrinter;
  169.     property PrinterBins: TStrings read GetPrinterBins;
  170.     property PrinterMargins: TGmValueRect read FPrinterMargins;
  171.     property PrinterNames: TStrings read GetPrinters;
  172.     property PrinterSelected: Boolean read GetPrinterSelected;
  173.     property PrinterIndex: integer read GetPrinterIndex write SetPrinterIndex;
  174.     property PrinterBinIndex: integer read GetPrinterBinIndex write SetPrinterBinIndex;
  175.  
  176.     property Printing: Boolean read FPrinting default False;
  177.     property IndexOf[printer: string]: integer read GetIndexOf;
  178.     property Offset: TPoint read GetOffset;
  179.     property Orientation: TGmOrientation read GetOrientation write SetOrientation;
  180.     property ShowServer: Boolean read FShowServer write SetShowServer default True;
  181.     property Title: string read GetTitle write SetTitle;
  182.   published
  183.     property DitherType: TGmDitherType read GetDitherType write SetDitherType;
  184.     property Duplex: TGmDuplexType read GetDuplexType write SetDuplexType;
  185.     property PrintColor: TGmPrintColor read GetPrintColorMode write SetPrinterColorMode;
  186.     property PrintQuality: TGmPrintQuality read GetPrintQuality write SetPrintQuality default gmMedium;
  187.   end;
  188.  
  189.   // *** TPrinterDevice ***
  190.  
  191.   TPrinterDevice = class
  192.     Driver, Device, Port: String;
  193.     constructor Create(ADriver, ADevice, APort: PChar);
  194.   end;
  195.  
  196.   // *** TGmPage ***
  197.  
  198.   {PGmPageObject = ^GmPageObject;
  199.  
  200.   GmPageObject = record
  201.     PrevObj: PGmPageObject;
  202.     AObject: TGmBaseObject;
  203.     NextObj: PGmPageObject;
  204.   end;}
  205.  
  206.  
  207.  
  208.   TGmPage = class(TList)
  209.   private
  210.     FMetafile: TMetafile;
  211.     //FCount: integer;
  212.  
  213.     {FStartObject: PGmPageObject;
  214.     FObjects: PGmPageObject;}
  215.  
  216.     FOrientation: TGmOrientation;
  217.     FPageNum: integer;
  218.     FPreview: TGmPreview;
  219.     FInchWidth,
  220.     FInchHeight: Extended;
  221.  
  222.     //procedure Add(AObject: TGmBaseObject);
  223.  
  224.     function GetObject(AIndex: integer): TGmBaseObject;
  225.     procedure SetObject(AIndex: integer; AObject: TGmBaseObject);
  226.     procedure SetOrientation(AOrientation: TGmOrientation);
  227.   public
  228.     constructor Create(APreview: TGmPreview);
  229.     destructor Destroy; override;
  230.     procedure AddObject(AObject: TGmBaseObject);
  231.     procedure Clear; {$IFNDEF VER100} override; {$ENDIF}
  232.     procedure DrawPage;//(InchWidth, InchHeight: Extended);
  233.     procedure LoadFromStream(AStream: TStream);
  234.     procedure SaveToStream(AStream: TStream);
  235.     //property Count: integer read FCount;
  236.     property Metafile: TMetafile read FMetafile write FMetafile;
  237.     property GmObject[index: integer]: TGmBaseObject read GetObject write SetObject;
  238.     property Orientation: TGmOrientation read FOrientation write SetOrientation;
  239.     property PageNum: integer read FPageNum;
  240.   end;
  241.  
  242.  
  243.   // *** TGmPageList ***
  244.  
  245.   TGmPageList = class(TList)
  246.   private
  247.     FPreview: TGmPreview;
  248.     function GetPage(APageIndex: integer): TGmPage;
  249.     procedure Repaginate;
  250.     procedure SetPage(APageIndex: integer ;APage: TGmPage);
  251.   public
  252.     constructor Create(AOwner: TGmPreview);
  253.     destructor Destroy; override;
  254.     function AddPage: TGmPage;
  255.     procedure Clear; {$IFNDEF VER100} override; {$ENDIF}
  256.     procedure DeletePage(APage: integer);
  257.     property Page[AIndex: integer]: TGmPage read GetPage write SetPage;
  258.   end;
  259.  
  260.   // *** TGmCanvas ***
  261.  
  262.   TGmCanvas = class(TPersistent)
  263.   private
  264.     FBrush: TBrush;
  265.     FCoordsRelative: TGmCoordsRelative;
  266.     FCopyMode: TCopyMode;
  267.     FCurrentPos: TPoint;
  268.     FDefaultMeasurement: TGmMeasurement;
  269.     FFont: TFont;
  270.     FPage: TGmPage;
  271.     FPen: TPen;
  272.     FPreview: TGmPreview;
  273.     FSavedPen: TPen;
  274.     FSavedBrush: TBrush;
  275.     FTempMetafile: TMetafile;
  276.     FTempCanvas: TMetafileCanvas;
  277.     FValue1: TGmValue;
  278.     FValue2: TGmValue;
  279.     function GetLeft: integer;
  280.     function GetTop: integer;
  281.     procedure CanvasChanged;
  282.     procedure DrawRect(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement; RectType: TGmRectType);
  283.   protected
  284.     procedure SavePen(var Message: TMessage); message GM_SAVE_PEN;
  285.     procedure RestorePen(var Message: TMessage); message GM_RESTORE_PEN;
  286.     procedure SaveBrush(var Message: TMessage); message GM_SAVE_BRUSH;
  287.     procedure RestoreBrush(var Message: TMessage); message GM_RESTORE_BRUSH;
  288.   public
  289.     constructor Create(AOwner: TGmPreview);
  290.     destructor Destroy; override;
  291.     function GraphicHeight(AGraphic: TGraphic): TGmValue;
  292.     function GraphicWidth(AGraphic: TGraphic): TGmValue;
  293.     function TextHeight(AText: string): TGmValue;
  294.     function TextWidth(AText: string): TGmValue;
  295.  
  296.     procedure Arc(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);                {$IFNDEF VER100} overload; {$ENDIF}
  297.     procedure Chord(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);                {$IFNDEF VER100} overload; {$ENDIF}
  298.     procedure Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended; GmMeasurement: TGmMeasurement);  {$IFNDEF VER100} overload; {$ENDIF}
  299.     procedure Ellipse(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                            {$IFNDEF VER100} overload; {$ENDIF}
  300.     procedure FillRect(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                           {$IFNDEF VER100} overload; {$ENDIF}
  301.     procedure FloatOut(x, y, AValue: Extended; Format: string; GmMeasurement: TGmMeasurement);           {$IFNDEF VER100} overload; {$ENDIF}
  302.     procedure Line(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                               {$IFNDEF VER100} overload; {$ENDIF}
  303.     procedure LineExt(x, y, x2, y2: Extended; LineWidth: Integer; GmMeasurement: TGmMeasurement);        {$IFNDEF VER100} overload; {$ENDIF}
  304.     procedure LineTo(x, y: Extended; GmMeasurement: TGmMeasurement);
  305.     procedure MoveTo(x, y: Extended; GmMeasurement: TGmMeasurement);
  306.     procedure Pie(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);                {$IFNDEF VER100} overload; {$ENDIF}
  307.  
  308.     {$IFNDEF VER100}
  309.     procedure Polygon(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);                         {$IFNDEF VER100} overload; {$ENDIF}
  310.     procedure PolyLine(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);                        {$IFNDEF VER100} overload; {$ENDIF}
  311.     procedure PolyLineTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  312.     procedure PolyBezier(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);                      {$IFNDEF VER100} overload; {$ENDIF}
  313.     procedure PolyBezierTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  314.     {$ENDIF}
  315.     procedure Rectangle(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);                          {$IFNDEF VER100} overload; {$ENDIF}
  316.     procedure RotateOut(x, y, Angle: Extended; AText: string; GmMeasurement: TGmMeasurement);            {$IFNDEF VER100} overload; {$ENDIF}
  317.     procedure RoundRect(x, y, x2, y2, x3, y3: Extended; GmMeasurement: TGmMeasurement);                  {$IFNDEF VER100} overload; {$ENDIF}
  318.     procedure StretchDraw(x,y, x2, y2: Extended; AGraphic: TGraphic; GmMeasurement: TGmMeasurement);     {$IFNDEF VER100} overload; {$ENDIF}
  319.     function TextBox(x, y, x2, y2: Extended; AText: string;
  320.       Alignment: TAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;                    {$IFNDEF VER100} overload; {$ENDIF}
  321.     function TextBoxExt(x, y, x2, y2: Extended; AText: string;
  322.       Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended; {$IFNDEF VER100} overload; {$ENDIF}
  323.     procedure TextExtent(AText : string; var AWidth, AHeight: TGmValue);
  324.     {$IFNDEF BCB}
  325.     procedure TextOut(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);                     {$IFNDEF VER100} overload; {$ENDIF}
  326.     {$ENDIF}
  327.     procedure TextOutLeft(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);                 {$IFNDEF VER100} overload; {$ENDIF}
  328.     procedure TextOutRight(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);                {$IFNDEF VER100} overload; {$ENDIF}
  329.  
  330.     { overloaded methods }
  331.  
  332.     {$IFNDEF VER100}
  333.     procedure Ellipse(ARect: TGmRect; GmMeasurement: TGmMeasurement); overload;
  334.     procedure FillRect(ARect: TGmRect; GmMeasurement: TGmMeasurement); overload;
  335.     procedure Line(ARect: TGmRect; GmMeasurement: TGmMeasurement); overload;
  336.     procedure LineExt(ARect: TGmRect; LineWidth: integer; GmMeasurement: TGmMeasurement); overload;
  337.     procedure Rectangle(ARect: TGmRect; GmMeasurement: TGmMeasurement); overload;
  338.     procedure RoundRect(ARect: TGmRect; X3, Y3: Extended; GmMeasurement: TGmMeasurement); overload;
  339.     function TextBox(ARect: TGmRect; AText: string;
  340.        Alignment: TAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;  overload;
  341.     function TextBoxExt(ARect: TGmRect; AText: string;
  342.       Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended; overload;
  343.  
  344.     // methods which use the default measurement...
  345.     procedure Arc(x1, y1, x2, y2, x3, y3, x4, y4: Extended); overload;
  346.     procedure Chord(x1, Y1, x2, y2, x3, y3, x4, y4: Extended); overload;
  347.     procedure Draw(X,Y: double; AGraphic: TGraphic; Scale: Extended); overload;
  348.     procedure Ellipse(X, Y, x2, y2: Extended); overload;
  349.     procedure FillRect(X, Y, x2, y2: Extended); overload;
  350.     procedure FloatOut(X, Y, AValue: Extended; Format: string); overload;
  351.     procedure Line(X, Y, x2, y2: Extended);  overload;
  352.     procedure LineExt(X, Y, x2, y2: Extended; LineWidth: Integer); overload;
  353.     procedure Pie(x, Y, x2, y2, x3, y3, x4, y4: Extended); overload;
  354.     procedure RotateOut(X, Y, Angle: Extended; AText: string); overload;
  355.     {$IFNDEF BCB}
  356.     procedure TextOut(X, Y: Extended; AText: string); overload;
  357.     {$ENDIF}
  358.     procedure TextOutLeft(X, Y: Extended; AText: string); overload;
  359.     procedure TextOutRight(X, Y: Extended; AText: string); overload;
  360.     function TextBox(X, Y, x2, y2: Extended; AText: string;
  361.       Alignment: TAlignment; Draw: Boolean): Extended; overload;
  362.     function TextBoxExt(X, Y, x2, y2: Extended; AText: string;
  363.       Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean): Extended; overload;
  364.     procedure Rectangle(X, Y, x2, y2: Extended); overload;
  365.     procedure RoundRect(X, Y, x2, y2, x3, y3: Extended); overload;
  366.     procedure Polygon(Points: array of TGmPoint); overload;
  367.     procedure PolyLine(Points: array of TGmPoint); overload;
  368.     procedure PolyBezier(Points: array of TGmPoint); overload;
  369.     procedure StretchDraw(X,Y, x2, y2: Extended; AGraphic: TGraphic); overload;
  370.  
  371.    {$ENDIF}
  372.  
  373.     property Brush: TBrush read FBrush write FBrush;
  374.     property CopyMode: TCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
  375.     property CoordsRelativeTo: TGmCoordsRelative read FCoordsRelative write FCoordsRelative default fromPage;
  376.     property DefaultMeasurement: TGmMeasurement read FDefaultMeasurement write FDefaultMeasurement default GmMillimeters;
  377.     property Font: TFont read FFont write FFont;
  378.     property Page: TGmPage read FPage write FPage;
  379.     
  380.     property Pen: TPen read FPen write FPen;
  381.   end;
  382.  
  383.   // *** TGmMargins ***
  384.  
  385.   TGmPageImage = class;
  386.  
  387.   TGmMargins = class(TPersistent)
  388.   private
  389.     FClipMargins: Boolean;
  390.     FPaintBox: TGmPageImage;
  391.     FBottom: TGmValue;
  392.     FLeft: TGmValue;
  393.     FPen: TPen;
  394.     FRight: TGmValue;
  395.     FTop: TGmValue;
  396.     FPreview: TGmPreview;
  397.     FPrinterPen: TPen;
  398.     FShowPrintMargins: Boolean;
  399.     FVisible: Boolean;
  400.     procedure PenChange(Sender: TObject);
  401.     procedure SetClipMargins(AValue: Boolean);
  402.     procedure SetShowPrinterMargins(AValue: Boolean);
  403.     procedure SetVisible(AValue: Boolean);
  404.     procedure MarginsChanged(AObject: TObject);
  405.   public
  406.     constructor Create(AOwner: TGmPreview);
  407.     destructor Destroy; override;
  408.     function AreMarginsValid: Boolean;
  409.     procedure Assign(Source: TPersistent); override;
  410.     procedure LoadFromStream(AStream: TStream);
  411.     procedure SaveToStream(AStream: TStream);
  412.     procedure UsePrinterMargins;
  413.     property Bottom: TGmValue read FBottom write FBottom;
  414.     property Left: TGmValue read FLeft write FLeft;
  415.     property Right: TGmValue read FRight write FRight;
  416.     property Top: TGmValue read FTop write FTop;
  417.   published
  418.     property ClipMargins: Boolean read FClipMargins write SetClipMargins default False;
  419.     property Pen: TPen read FPen write FPen;
  420.     property PrinterMarginPen: TPen read FPrinterPen write FPrinterPen;
  421.     property ShowPrinterMargins: Boolean read FShowPrintMargins write SetShowPrinterMargins default False;
  422.     property Visible: Boolean read FVisible write SetVisible default False;
  423.   end;
  424.  
  425.   // *** TGmPageImage ***
  426.  
  427.   TGmPageImage = class(TGmCustomPage)
  428.   private
  429.     FValue1: TGmValue;
  430.     FValue2: TGmValue;
  431.     FMargins: TObject;
  432.     FHeightInches: Extended;
  433.     FWidthInches: Extended;
  434.     FPageHeight: integer;
  435.     FPageWidth: integer;
  436.     FScale: Extended;
  437.     procedure SetHeightInches(AValue: Extended);
  438.     procedure SetWidthInches(AValue: Extended);
  439.     procedure RecalculateSize;
  440.     procedure SetScale(AScale: Extended);
  441.   protected
  442.     procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
  443.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  444.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  445.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  446.     procedure Paint; override;
  447.   public
  448.     constructor Create(AOwner: TComponent); override;
  449.     destructor Destroy; override;
  450.     property Margins: TObject write FMargins;
  451.     property HeightInches: Extended read FHeightInches write SetHeightInches;
  452.     property WidthInches: Extended read FWidthInches write SetWidthInches;
  453.     property Scale: Extended read FScale write SetScale;
  454.   end;
  455.  
  456.   // *** TGmHeaderFooterCaption ***
  457.  
  458.   TGmHeaderFooter = class;
  459.   TGmHeaderFooterCaption = class(TPersistent)
  460.   private
  461.     FCaption: string;
  462.     FFont: TFont;
  463.     FHeaderFooter: TGmHeaderFooter;
  464.     procedure FontChange(Sender: TObject);
  465.     procedure SetCaption(ACaption: string);
  466.     procedure SetFont(AFont: TFont);
  467.   public
  468.     constructor Create(AOwner: TGmHeaderFooter);
  469.     destructor Destroy; override;
  470.     procedure Assign(Source: TPersistent); override;
  471.     procedure LoadFromStream(AStream: TStream);
  472.     procedure SaveToStream(AStream: TStream);
  473.   published
  474.     property Caption: string read FCaption write SetCaption;
  475.     property Font: TFont read FFont write SetFont;
  476.   end;
  477.  
  478.   // *** TGmHeaderFooter ***
  479.  
  480.   THeaderFooterState = (hfIdle, hfCreating, hfDestroying, hfDrawing, hfPrinting);
  481.  
  482.   TGmHeaderFooter = class(TPersistent)
  483.   private
  484.     FCanvas: TGmCanvas;
  485.     FCaptionLeft  : TGmHeaderFooterCaption;
  486.     FCaptionRight : TGmHeaderFooterCaption;
  487.     FCaptionCenter: TGmHeaderFooterCaption;
  488.  
  489.     FPen: TPen;
  490.     FPreview: TGmPreview;
  491.     FShowLine: Boolean;
  492.     FState: THeaderFooterState;
  493.     FVisible: Boolean;
  494.     FHeight: TGmValue;
  495.  
  496.     procedure SetCaptionLeft(ACaption: string);
  497.     procedure SetCaptionCenter(ACaption: string);
  498.     procedure SetCaptionRight(ACaption: string);
  499.     procedure SetCaptionLeftFont(AFont: TFont);
  500.     procedure SetCaptionCenterFont(AFont: TFont);
  501.     procedure SetCaptionRightFont(AFont: TFont);
  502.     function GetCaptionLeft: string;
  503.     function GetCaptionCenter: string;
  504.     function GetCaptionRight: string;
  505.     function GetCaptionLeftFont: TFont;
  506.     function GetCaptionCenterFont: TFont;
  507.     function GetCaptionRightFont: TFont;
  508.  
  509.     procedure PenChange(Sender: TObject);
  510.     procedure SetPen(APen: TPen);
  511.     procedure SetShowLine(AValue: Boolean);
  512.     procedure SetVisible(AVisible: Boolean);
  513.     function GetCaptionHeight(ACanvas: TCanvas; ACaption: string): integer;
  514.     function GetHeight: TGmValue;
  515.     function GetLargestFont: TFont;
  516.   protected
  517.     procedure Draw(ACanvas: TCanvas; Margins: TGmMargins; PageRect: TRect;
  518.       APageNum: integer; Scale: Extended); virtual; abstract;
  519.     procedure LoadFromStream(AStream: TStream);
  520.     procedure SaveToStream(AStream: TStream);
  521. //    procedure Print(ACanvas: TCanvas; Margins: TGmMargins; PW, PH, PNum: integer); virtual; abstract;
  522.   public
  523.     constructor Create(AOwner: TGmPreview);
  524.     destructor Destroy; override;
  525.     procedure Assign(Source: TPersistent); override;
  526.     property Height: TGmValue read GetHeight;
  527.     procedure RequestUpdate;
  528.   published
  529.     property CaptionLeft: string read GetCaptionLeft write SetCaptionLeft;
  530.     property CaptionLeftFont: TFont read GetCaptionLeftFont write SetCaptionLeftFont;
  531.     property CaptionCenter: string read GetCaptionCenter write SetCaptionCenter;
  532.     property CaptionCenterFont: TFont read GetCaptionCenterFont write SetCaptionCenterFont;
  533.     property CaptionRight: string read GetCaptionRight write SetCaptionRight;
  534.     property CaptionRightFont: TFont read GetCaptionRightFont write SetCaptionRightFont;
  535.     property Pen: TPen read FPen write SetPen;
  536.     property ShowLine: Boolean read FShowLine write SetShowLine default True;
  537.     property Visible: Boolean read FVisible write SetVisible default True;
  538.   end;
  539.  
  540.   // *** TGmHeader ***
  541.  
  542.   TGmHeader = class(TGmHeaderFooter)
  543.   public
  544.     procedure Draw(ACanvas: TCanvas; Margins: TGmMargins; PageRect: TRect;
  545.       APageNum: integer; Scale: Extended); override;
  546.   end;
  547.  
  548.   // *** TGmFooter ***
  549.  
  550.   TGmFooter = class(TGmHeaderFooter)
  551.   public
  552.     procedure Draw(ACanvas: TCanvas; Margins: TGmMargins; PageRect: TRect;
  553.       APageNum: integer; Scale: Extended); override;
  554.   end;
  555.  
  556.   // *** TGmPreview ***
  557.  
  558.   TGmPreviewState   = (gmCreating, gmDestroying, gmIdle, gmClearing);
  559.  
  560.   TGmOptions = class(TPersistent)
  561.   private
  562.     FZoomIn: TGmUserAction;
  563.     FZoomOut: TGmUserAction;
  564.     procedure SetZoomIn(AUserAction: TGmUserAction);
  565.     procedure SetZoomOut(AUserAction: TGmUserAction);
  566.   public
  567.     constructor Create;
  568.   published
  569.     property ZoomInAction: TGmUserAction read FZoomIn write SetZoomIn default LeftButton;
  570.     property ZoomOutAction: TGmUserAction read FZoomIn write SetZoomOut default RightButton;
  571.   end;
  572.  
  573.   TGmPreview = class(TScrollingWinControl)
  574.   private
  575.     FBorderStyle: TBorderStyle;
  576.     FCanvas: TGmCanvas;
  577.     FCurrentPage: integer;
  578.     FPageHeight: TGmValue;
  579.     FPageWidth: TGmValue;
  580.     FFooter: TGmFooter;
  581.     FGutter: integer;
  582.     FHeader: TGmHeader;
  583.     FPaperSize: TGmPaperSize;
  584.     FMessagesEnabled: Boolean;
  585.     FOrientation: TGmOrientation;
  586.     FMargins: TGmMargins;
  587.     FMaxZoom: integer;
  588.     FMinZoom: integer;
  589.     FMousePos: TPoint;
  590.     FNumPages: integer;
  591.     FOptions: TGmOptions;
  592.     FPageImage: TGmPageImage;
  593.     FPages: TGmPageList;
  594.     FPagesPerSheet: TGmPagesPerSheet;
  595.     FPanning: Boolean;
  596.     FPanningXYStart: TPoint;
  597.     FPreviewState: TGmPreviewState;
  598.     FPrintBorder: TGmValue;
  599.     FPrintCopies: integer;
  600.     FPrinter: TGmPrinter;
  601.     FPrintFile: string;
  602.     FRegisteredComponents: TList;
  603.     FZoom: integer;
  604.     FZoomIncrement: integer;
  605.     FZoomStyle: TGmZoomStyle;
  606.     // Events...
  607.     FAfterPrint: TNotifyEvent;
  608.     FBeforeLoad: TBeforeLoadEvent;
  609.     FBeforePrint: TNotifyEvent;
  610.     FBeforePrintPage:TBeforePrintPage;
  611.     FBeforeReadStream: TBeforeReadStream;
  612.     FBeforeWriteStream: TBeforeWriteStream;
  613.     FOnAbortPrint: TNotifyEvent;
  614.     FOnCanvasChange: TNotifyEvent;
  615.     FOnChangeMargins: TNotifyEvent;
  616.     FOnChangeOrientation: TNotifyEvent;
  617.     FOnChangePageOrientation: TPageOrientationChanged;
  618.     FOnChangePrinter: TNotifyEvent;
  619.     FOnClear: TNotifyEvent;
  620.     FOnDeletePage: TNotifyEvent;
  621.     FOnLoadProgress: TFileProgressEvent;
  622.     FOnNewPage: TNotifyEvent;
  623.     FOnPageChange: TOnPageChangeEvent;
  624.     FOnPageMouseDown: TPageMouseEvent;
  625.     FOnPageMouseMove: TPageMouseMoveEvent;
  626.     FOnPageMouseUp  : TPageMouseEvent;
  627.     FOnPageSizeChange: TNotifyEvent;
  628.     FOnPrintProgress: TOnPrintProgressEvent;
  629.     FOnSaveProgress: TFileProgressEvent;
  630.     FOnZoom: TOnZoomEvent;
  631.  
  632.     function GetCoordsRelative: TGmCoordsRelative;
  633.     function GetFitHeightZoom: integer;
  634.     function GetFitWidthZoom: integer;
  635.     function GetMetaFile(APage: integer): TMetaFile;
  636.     function GetNumPages: integer;
  637.     function GetOrientationType: TGmOrientationType;
  638.     function GetPage(APage: integer): TGmPage;
  639.     function GetPrinterBinIndex: integer;
  640.     function GetPrinterBins: TStrings;
  641.     function GetPrinterIndex: integer;
  642.     function GetPrinters: TStrings;
  643.     function GetPrintTitle: string;
  644.     function GetShadow: TGmShadow;
  645.     function GetVersion: Extended;
  646.     function PaperSizeToStr(APaperSize: TGmPaperSize): string;
  647.     function StrToPaperSize(APaperStr: string): TGmPaperSize;
  648.     procedure CenterPage;
  649.     // load/save functions...
  650.     procedure LoadPageSetupFromStream(AStream: TStream);
  651.     procedure SavePageSetupToStream(AStream: TStream);
  652.     procedure LoadDocInfoFromStream(AStream: TStream);
  653.     procedure SaveDocInfoToStream(AStream: TStream);
  654.     procedure SetBorderStyle(AStyle: TBorderStyle);
  655.     procedure SetCoordsRelative(ACoordsRelative: TGmCoordsRelative);
  656.     procedure SetCurrentPage(APage: integer);
  657.     procedure SetGutter(AGutter: integer);
  658.     procedure SetOrientation(AOrientation: TGmOrientation);
  659.     procedure SetPagesPerSheet(APagesPerSheet: TGmPagesPerSheet);
  660.     procedure SetPaperSize(APaperSize: TGmPaperSize);
  661.     procedure SetPrintCopies(APrintCopies: integer);
  662.     procedure SetPrinterBinIndex(AIndex: integer);
  663.     procedure SetPrinterIndex(AIndex: integer);
  664.     procedure SetPrintTitle(ATitle: string);
  665.     procedure SetZoom(AZoom: integer);
  666.     { Private declarations }
  667.   protected
  668.     procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
  669.     procedure CreateParams(var Params: TCreateParams); override;
  670.     procedure Loaded; override;
  671.     procedure MessageToControls(AMessage: integer; Param1, Param2: integer);
  672.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  673.     procedure SetParent(AParent: TWinControl); override;
  674.     procedure PositionPage;
  675.     procedure PreviewResize(var Message: TMessage); message WM_SIZE;
  676.     procedure UpdateMessage(var Message: TMessage); message GM_UPDATE_PREVIEW;
  677.     procedure MarginsChanged(var Message: TMessage); message GM_USER_MARGINS_CHANGED;
  678.     //procedure RegisterComponent(var Message: TMessage); message GM_REGISTER_COMPONENT;
  679.     //procedure UnRegisterComponent(var Message: TMessage); message GM_UNREGISTER_COMPONENT;
  680.     { Protected declarations }
  681.   public
  682.     constructor Create(AOwner: TComponent); override;
  683.     destructor Destroy; override;
  684.     procedure AddAssociatedComponent(AComponent: TComponent);
  685.     procedure RemoveAssociatedComponent(AComponent: TComponent);
  686.     function GetFileVersion(AFileName: string): Extended;
  687.     function NewPage: TGmPage;
  688.     function Tokenize(AText: string; APage: integer): string;
  689.     procedure CenterOnClick(x, y: integer);
  690.     procedure Clear;
  691.     procedure DeleteCurrentPage;
  692.     procedure DeletePage(APage: integer);
  693.     procedure FirstPage;
  694.     procedure FitHeight;
  695.     procedure FitWidth;
  696.     procedure FitWholePage;
  697.     procedure LastPage;
  698.     procedure LoadFromStream(AStream: TStream);
  699.     procedure LoadFromFile(AFilename: string);
  700.     procedure NextPage;
  701.     procedure PrevPage;
  702.     procedure Print;
  703.     procedure PrintRange(AStartPage, AEndPage: integer);
  704.     procedure PrintCurrentPage;
  705.     procedure PrintToFile(AFileName: string);
  706.     procedure SaveToStream(AStream: TStream);
  707.     procedure SaveToFile(AFilename: string);
  708.     procedure ScrollToPosition(XPercent, YPercent: Extended);
  709.     procedure SetCursor(ACursor: TGmCursor);
  710.     procedure SetPageSize(AWidth, AHeight: Extended; AUnits: TGmMeasurement);
  711.     procedure StartPanning;
  712.     procedure StopPanning;
  713.     procedure UpdatePreview;
  714.     procedure UsePrinterPageSize;
  715.     procedure ZoomIn;
  716.     procedure ZoomOut;
  717.  
  718.     property Canvas: TGmCanvas read FCanvas write FCanvas;
  719.     property CoordsRelativeTo: TGmCoordsRelative read GetCoordsRelative write SetCoordsRelative default fromPage;
  720.     property CurrentPage: integer read FCurrentPage write SetCurrentPage;
  721.     property MessagesEnabled: Boolean read FMessagesEnabled write FMessagesEnabled;
  722.     property MetaFile[APage: Integer]: TMetaFile read GetMetaFile;
  723.     property NumPages: integer read GetNumPages;
  724.     property Pages[Index: integer]: TGmPage read GetPage;
  725.     property PageHeight: TGmValue read FPageHeight write FPageHeight;
  726.     property PageWidth: TGmValue read FPageWidth write FPageWidth;
  727.     property Panning: Boolean read FPanning;
  728.     property PreviewState: TGmPreviewState read FPreviewState;
  729.     property PrintBorder: TGmValue read FPrintBorder write FPrintBorder;
  730.     property PrinterIndex: integer read GetPrinterIndex write SetPrinterIndex;
  731.     property Printers: TStrings read GetPrinters;
  732.     property PrinterBins: TStrings read GetPrinterBins;
  733.     property PrinterBinIndex: integer read GetPrinterBinIndex write SetPrinterBinIndex;
  734.     property Version: Extended read GetVersion;
  735.     { Public declarations }
  736.   published
  737.     {properties available from Delphi 4...}
  738.     {$IFNDEF VER100}
  739.     property Anchors;
  740.     property Constraints;
  741.     {$ENDIF}
  742.  
  743.     // properties...
  744.     property Align;
  745.     property Color;
  746.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  747.     property Footer: TGmFooter read FFooter write FFooter;
  748.     property GmPrinter: TGmPrinter read FPrinter write FPrinter;
  749.     property Gutter: integer read FGutter write SetGutter;
  750.     property Header: TGmHeader read FHeader write FHeader;
  751.     property Margins: TGmMargins read FMargins write FMargins;
  752.     property MaxZoom: integer read FMaxZoom write FMaxZoom default 400;
  753.     property MinZoom: integer read FMinZoom write FMinZoom default 10;
  754.     property Orientation: TGmOrientation read FOrientation write SetOrientation;
  755.     property PagesPerSheet: TGmPagesPerSheet read FPagesPerSheet write SetPagesPerSheet default gmOnePage;
  756.     property PaperSize: TGmPaperSize read FPaperSize write SetPaperSize default A4;
  757.     property PrintCopies: integer read FPrintCopies write SetPrintCopies default 1;
  758.     property Shadow: TGmShadow read GetShadow;
  759.     property ShowHint;
  760.     property TabOrder;
  761.     property Title: string read GetPrintTitle write SetPrintTitle;
  762.     property Visible;
  763.     property Zoom: integer read FZoom write SetZoom default DEFAULT_ZOOM;
  764.     property ZoomIncrement: integer read FZoomIncrement write FZoomIncrement default 10;
  765.     property ZoomStyle: TGmZoomStyle read FZoomStyle write FZoomStyle;
  766.     // Events...
  767.     property AfterPrint: TNotifyEvent read FAfterPrint write FAfterPrint;
  768.     property BeforeLoad: TBeforeLoadEvent read FBeforeLoad write FBeforeLoad;
  769.     property BeforePrint: TNotifyEvent read FBeforePrint write FBeforePrint;
  770.     property BeforePrintPage: TBeforePrintPage read FBeforePrintPage write FBeforePrintPage;
  771.     property BeforeReadStream: TBeforeReadStream read FBeforeReadStream write FBeforeReadStream;
  772.     property BeforeWriteStream: TBeforeWriteStream read FBeforeWriteStream write FBeforeWriteStream;
  773.     property OnAbortPrint: TNotifyEvent read FOnAbortPrint write FOnAbortPrint;
  774.     property OnCanvasChange: TNotifyEvent read FOnCanvasChange write FOnCanvasChange;
  775.     property OnChangeMargins: TNotifyEvent read FOnChangeMargins write FOnChangeMargins;
  776.     property OnChangeOrientation: TNotifyEvent read FOnChangeOrientation write FOnChangeOrientation;
  777.     property OnChangePageOrientation: TPageOrientationChanged read FOnChangePageOrientation write FOnChangePageOrientation;
  778.     property OnChangePrinter: TNotifyEvent read FOnChangePrinter write FOnChangePrinter;
  779.     property OnClear: TNotifyEvent read FOnClear write FOnClear;
  780.     property OnDeletePage: TNotifyEvent read FOnDeletePage write FOnDeletePage;
  781.     property OnDragDrop;
  782.     property OnDragOver;
  783.     property OnEndDrag;
  784.     property OnLoadProgess: TFileProgressEvent read FOnLoadProgress write FOnLoadProgress;
  785.  
  786.     property OnMouseDown;
  787.     property OnMouseMove;
  788.     property OnMouseUp;
  789.     property OnNewPage: TNotifyEvent read FOnNewPage write FOnNewPage;
  790.     property OnPageChange: TOnPageChangeEvent read FOnPageChange write FOnPageChange;
  791.     property OnPageMouseDown: TPageMouseEvent read FOnPageMouseDown write FOnPageMouseDown;
  792.     property OnPageMouseMove: TPageMouseMoveEvent read FOnPageMouseMove write FOnPageMouseMove;
  793.     property OnPageMouseUp: TPageMouseEvent read FOnPageMouseUp write FOnPageMouseUp;
  794.  
  795.     property OnPageSizeChange: TNotifyEvent read FOnPageSizeChange write FOnPageSizeChange;
  796.     property OnPrintProgress: TOnPrintProgressEvent read FOnPrintProgress write FOnPrintProgress;
  797.     {$IFNDEF VER100}
  798.     property OnResize;
  799.     {$ENDIF}
  800.     property OnSaveProgress: TFileProgressEvent read FOnSaveProgress write FOnSaveProgress;
  801.     property OnStartDrag;
  802.     property OnZoom: TOnZoomEvent read FOnZoom write FOnZoom;
  803.     { Published declarations }
  804.   end;
  805.  
  806. // *** Global function declarations ***
  807. function ConvertValue(AValue: Extended; UnitsFrom, UnitsTo: TGmMeasurement): Extended;
  808. function GmPoint(x, y: Extended): TGmPoint;
  809. function GmRect(x, y, x2, y2: Extended): TGmRect;
  810. function MinInt(Int1, Int2: Integer): Integer;
  811. function MaxInt(Int1, Int2: Integer): Integer;
  812. procedure SwapValues(var x,y: integer);
  813.  
  814. implementation
  815.  
  816. uses Printers, GmErrors, WinSpool, Consts, GmLegacy;
  817.  
  818. {$R GmCursors.RES}
  819.  
  820. //------------------------------------------------------------------------------
  821.  
  822. // *** Global functions ***
  823.  
  824. // function similar to "Point" to allow TGmPoint to be cast like... GmPoint(10.4, 6.8)...
  825.  
  826. function GmPoint(x, y: Extended): TGmPoint;
  827. begin
  828.   Result.x := x;
  829.   Result.y := y;
  830. end;
  831.  
  832. // function similar to "Rect" to allow a TGmRect to be defined as GmRect(1,1,5,6);
  833.  
  834. function GmRect(x, y, x2, y2: Extended): TGmRect;
  835. begin
  836.   with Result do
  837.   begin
  838.     Left    := x;
  839.     Top     := y;
  840.     Right   := x2;
  841.     Bottom  := y2;
  842.   end;
  843. end;
  844.  
  845. function MaxInt(Int1, Int2: Integer): Integer;
  846. begin
  847.   if Int1 > Int2 then Result := Int1 else Result := Int2;
  848. end;
  849.  
  850. function MinInt(Int1, Int2: Integer): Integer;
  851. begin
  852.   if Int1 < Int2 then Result := Int1 else Result := Int2;
  853. end;
  854.  
  855. function MaxExt(Ext1, Ext2: Extended): Extended;
  856. begin
  857.   if Ext1 > Ext2 then Result := Ext1 else Result := Ext2;
  858. end;
  859.  
  860. function MinExt(Ext1, Ext2: Extended): Extended;
  861. begin
  862.   if Ext1 < Ext2 then Result := Ext1 else Result := Ext2;
  863. end;
  864.  
  865. function ConvertValue(AValue: Extended; UnitsFrom, UnitsTo: TGmMeasurement): Extended;
  866. var
  867.   AsUnits: Extended;
  868. begin
  869.   // firstly convert to GmUnits...
  870.   AsUnits := AValue;
  871.   case UnitsFrom of
  872.     GmMillimeters: AsUnits := (AValue * 100);
  873.     GmCentimeters: AsUnits := (AValue * 1000);
  874.     GmInches     : AsUnits := (AValue * 100) * 25.4;
  875.     GmPixels     : AsUnits :=((AValue * 100) * 25.4) / Screen.PixelsPerInch;
  876.   end;
  877.   // now convert to the desired measurement...
  878.   Result := AsUnits;
  879.   case UnitsTo of
  880.     GmMillimeters: Result := (AsUnits / 100);
  881.     GmCentimeters: Result := (AsUnits / 1000);
  882.     GmInches     : Result := (AsUnits / 100) / 25.4;
  883.     GmPixels     : Result :=((AsUnits / 100) / 25.4) * Screen.PixelsPerInch;
  884.   end;
  885. end;
  886.  
  887. function ScreenPpi: Integer;
  888. begin
  889.   Result := Screen.PixelsPerInch;
  890. end;
  891.  
  892. procedure SwapValues(var x,y: integer);
  893. var
  894.   z: integer;
  895. begin
  896.   z := y;
  897.   y := x;
  898.   x := z;
  899. end;
  900.  
  901. procedure GetPaperSize(APaperSize: TGmPaperSize; var AWidth, AHeight: Integer; AOrientation: TGmOrientation);
  902. var
  903.   w,h: Integer;
  904. begin
  905.   w := AHeight;
  906.   h := AWidth;
  907.   case APaperSize of
  908.     A3:
  909.       begin
  910.         w := 29700;
  911.         h := 42000;
  912.       end;
  913.     A4:
  914.       begin
  915.         w := 21000;
  916.         h := 29700;
  917.       end;
  918.     A5:
  919.       begin
  920.         w := 29700 div 2;
  921.         h := 21000;
  922.       end;
  923.     A6:
  924.       begin
  925.         w := 21000 div 2;
  926.         h := 29700 div 2;
  927.       end;
  928.     B5:
  929.       begin
  930.         w := 17600;
  931.         h := 25000;
  932.       end;
  933.     C5:
  934.       begin
  935.         w := 22900;
  936.         h := 16300;
  937.       end;
  938.     Legal:
  939.       begin
  940.         w := 21590;
  941.         h := 35560;
  942.       end;
  943.     Letter:
  944.       begin
  945.         w := 21590;
  946.         h := 27940;
  947.       end;
  948.   end;
  949.  
  950.   if AOrientation = gmPortrait then
  951.   begin
  952.     AWidth  := MinInt(w,h);
  953.     AHeight := MaxInt(h,w);
  954.   end
  955.   else
  956.   begin
  957.     AWidth  := MaxInt(w,h);
  958.     AHeight := MinInt(h,w);
  959.   end;
  960. end;
  961.  
  962. function PixelsPerInchX(Handle: THandle): integer;
  963. begin
  964.   Result := GetDeviceCaps(Handle, LOGPIXELSX);
  965. end;
  966.  
  967. function PixelsPerInchY(Handle: THandle): integer;
  968. begin
  969.   Result := GetDeviceCaps(Handle, LOGPIXELSY);
  970. end;
  971.  
  972. function FetchStr(var Str: PChar): PChar;
  973. var
  974.   P: PChar;
  975. begin
  976.   Result := Str;
  977.   if Str = nil then Exit;
  978.   P := Str;
  979.   while P^ = ' ' do Inc(P);
  980.   Result := P;
  981.   while (P^ <> #0) and (P^ <> ',') do Inc(P);
  982.   if P^ = ',' then
  983.   begin
  984.     P^ := #0;
  985.     Inc(P);
  986.   end;
  987.   Str := P;
  988. end;
  989.  
  990. //------------------------------------------------------------------------------
  991.  
  992. // *** TGmValue ***
  993.  
  994. constructor TGmValue.Create;
  995. begin
  996.   FValue := 0;
  997. end;
  998.  
  999. function TGmValue.GetAsPixels(Ppi: integer): Integer;
  1000. begin
  1001.   Result := Round((FValue / 2540) * Ppi);
  1002. end;
  1003.  
  1004. procedure TGmValue.SetAsPixels(Ppi: integer; AValue: Integer);
  1005. begin
  1006.   FValue := Round((AValue * 2540) / Ppi);
  1007.   if Assigned(FOnChange) then FOnChange(Self);
  1008. end;
  1009.  
  1010. procedure TGmValue.SetAsMm(AValue: Extended);
  1011. begin
  1012.   FValue := Round(AValue * 100);
  1013.   if Assigned(FOnChange) then FOnChange(Self);
  1014. end;
  1015.  
  1016. procedure TGmValue.SetAsCm(AValue: Extended);
  1017. begin
  1018.   FValue := Round((AValue * 100) * 10);
  1019.   if Assigned(FOnChange) then FOnChange(Self);
  1020. end;
  1021.  
  1022. procedure TGmValue.SetAsInches(AValue: Extended);
  1023. begin
  1024.   FValue := Round((AValue * 100) * 25.4);
  1025.   if Assigned(FOnChange) then FOnChange(Self);
  1026. end;
  1027.  
  1028. function TGmValue.GetAsMm: Extended;
  1029. begin
  1030.   Result := (FValue / 100);
  1031. end;
  1032.  
  1033. function TGmValue.GetAsCm: Extended;
  1034. begin
  1035.   Result := (FValue / 100) / 10;
  1036. end;
  1037.  
  1038. function TGmValue.GetAsInches: Extended;
  1039. begin
  1040.   Result := (FValue / 100) / 25.4;
  1041. end;
  1042.  
  1043. constructor TGmValueRect.Create;
  1044. begin
  1045.   inherited Create;
  1046.   FLeft   := TGmValue.Create;
  1047.   FTop    := TGmValue.Create;
  1048.   FRight  := TGmValue.Create;
  1049.   FBottom := TGmValue.Create;
  1050. end;
  1051.  
  1052. destructor TGmValueRect.Destroy;
  1053. begin
  1054.   FLeft.Free;
  1055.   FTop.Free;
  1056.   FRight.Free;
  1057.   FBottom.Free;
  1058.   inherited Destroy;
  1059. end;
  1060.  
  1061. //------------------------------------------------------------------------------
  1062.  
  1063. // *** TGmPrinter ***
  1064.  
  1065. constructor TGmPrinter.Create(AOwner: TGmPreview);
  1066. begin
  1067.   inherited Create;
  1068.   FPreview := AOwner;
  1069.   FPrinting := False;
  1070.   FValue := TGmValue.Create;
  1071.   FPrinterNames := TStringList.Create;
  1072.   FPrinterBins  := TStringList.Create;
  1073.   if PrinterSelected then
  1074.     Printer.PrinterIndex := Printer.PrinterIndex;
  1075.   Title := '<document>';
  1076.   FPrinterMargins := TGmValueRect.Create;
  1077.   UpdatePrinterMargins;
  1078. end;
  1079.  
  1080. destructor TGmPrinter.Destroy;
  1081. begin
  1082.   FPrinterMargins.Free;
  1083.   if Assigned(FValue) then FValue.Free;
  1084.   if Assigned(FPrinterNames) then FPrinterNames.Free;
  1085.   if Assigned(FPrinterBins) then FPrinterBins.Free;
  1086.   inherited Destroy;
  1087. end;
  1088.  
  1089. procedure TGmPrinter.Abort;
  1090. begin
  1091.   if (PrinterSelected) and (FPrinting) then
  1092.   begin
  1093.     Printer.Abort;
  1094.     FPrinting := False;
  1095.     if Assigned(FPreview.OnAbortPrint) then FPreview.OnAbortPrint(Self);
  1096.   end;
  1097. end;
  1098.  
  1099.  
  1100. procedure TGmPrinter.BeginDoc(AFilename: string);
  1101. var
  1102.   CTitle: array[0..31] of Char;
  1103.   DocInfo: TDocInfo;
  1104. begin
  1105.   if (PrinterSelected) and (not FPrinting) then
  1106.   begin
  1107.     if Assigned(FPreview.BeforePrint) then FPreview.BeforePrint(Self);
  1108.     FPrinting := True;
  1109.     Printer.BeginDoc;
  1110.     if AFilename <> '' then
  1111.     begin
  1112.       // print to file...
  1113.       EndPage(Canvas.handle);
  1114.       Windows.AbortDoc( Canvas.handle );
  1115.       { Restart it with a print file as destination. }
  1116.       StrPLCopy(CTitle, Title, SizeOf(CTitle) - 1);
  1117.       FillChar(DocInfo, SizeOf(DocInfo), 0);
  1118.       with DocInfo do
  1119.       begin
  1120.         cbSize := SizeOf(DocInfo);
  1121.         lpszDocName := CTitle;
  1122.         lpszOutput := PChar(AFilename);
  1123.       end;
  1124.       StartDoc(Canvas.handle, DocInfo);
  1125.       StartPage(Canvas.handle);
  1126.     end;
  1127.   end
  1128.   else
  1129.   begin
  1130.     if not PrinterSelected then ShowGmError(FPreview, NO_PRINTER_SELECTED);
  1131.     if FPrinting then ShowGmError(FPreview, PRINTING_IN_PROGRESS);
  1132.   end;
  1133. end;
  1134.  
  1135. procedure TGmPrinter.EndDoc;
  1136. begin
  1137.   if (PrinterSelected) and (FPrinting) then
  1138.   begin
  1139.     Printer.EndDoc;
  1140.     FPrinting := False;
  1141.     if Assigned(FPreview.AfterPrint) then FPreview.AfterPrint(Self);
  1142.   end
  1143.   else
  1144.     ShowGmError(FPreview, NO_PRINTER_SELECTED);
  1145. end;
  1146.  
  1147. function TGmPrinter.GetHandle:  THandle;
  1148. begin
  1149.   Result := 0;
  1150.   if PrinterSelected then
  1151.     Result := Printer.Handle
  1152.   else
  1153.     ShowGmError(FPreview, NO_PRINTER_SELECTED);
  1154. end;
  1155.  
  1156. function TGmPrinter.GetPrinterWidth: TGmValue;
  1157. begin
  1158.   Result := FValue;
  1159.   Result.AsUnits := 0;
  1160.   if PrinterSelected then
  1161.     Result.AsPixels[PrinterPpiX] := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
  1162. end;
  1163.  
  1164. function TGmPrinter.GetPrintQuality: TGmPrintQuality;
  1165. var
  1166.   Device : array[0..MAX_PATH] of char;
  1167.   Driver : array[0..MAX_PATH] of char;
  1168.   Port   : array[0..MAX_PATH] of char;
  1169.   hDMode : THandle;
  1170.   PDMode : PDEVMODE;
  1171. begin
  1172.   Printer.PrinterIndex := Printer.PrinterIndex;
  1173.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1174.   Result := gmDraft;
  1175.   if hDMode <> 0 then
  1176.   begin
  1177.     pDMode := GlobalLock(hDMode);
  1178.     if pDMode <> nil then
  1179.     begin
  1180.       {$IFDEF VER100}
  1181.       case LongInt(pDMode^.dmPrintQuality) of
  1182.       {$ELSE}
  1183.       case LongWord(pDMode^.dmPrintQuality) of
  1184.       {$ENDIF}
  1185.         DMRES_DRAFT : Result := gmDraft;
  1186.         DMRES_LOW   : Result := gmLow;
  1187.         DMRES_MEDIUM: Result := gmMedium;
  1188.         DMRES_HIGH  : Result := gmHigh;
  1189.       end;
  1190.       GlobalUnlock(hDMode);
  1191.       Printer.PrinterIndex := Printer.PrinterIndex;
  1192.     end;
  1193.   end;
  1194. end;
  1195.  
  1196. function TGmPrinter.GetPrinterHeight: TGmValue;
  1197. begin
  1198.   Result := FValue;
  1199.   Result.AsUnits := 0;
  1200.   if PrinterSelected then
  1201.     Result.AsPixels[PrinterPpiX] := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
  1202. end;
  1203.  
  1204. function TGmPrinter.GetPrinterAvailableWidth: TGmValue;
  1205. begin
  1206.   Result := FValue;
  1207.   Result.AsUnits := 0;
  1208.   if PrinterSelected then
  1209.     Result.AsPixels[PrinterPpiX] := GetDeviceCaps(Printer.Handle, HORZRES);
  1210. end;
  1211.  
  1212. function TGmPrinter.GetPrinterAvailableHeight: TGmValue;
  1213. begin
  1214.   Result := FValue;
  1215.   Result.AsUnits := 0;
  1216.   if PrinterSelected then
  1217.     Result.AsPixels[PrinterPpiX] := GetDeviceCaps(Printer.Handle, VERTRES);
  1218. end;
  1219.  
  1220. {function TGmPrinter.InchesToPrinterPixels(AUnits: Extended): integer;
  1221. begin
  1222.   Result := 0;
  1223.   if PrinterSelected then
  1224.     Result := Round(PixelsPerInchX(Printer.Handle) * AUnits);
  1225. end;}
  1226.  
  1227. function TGmPrinter.PrinterPpiX: integer;
  1228. begin
  1229.   Result := 0;
  1230.   if PrinterSelected then
  1231.     Result := PixelsPerInchX(GetHandle);
  1232. end;
  1233.  
  1234. function TGmPrinter.PrinterPpiY: integer;
  1235. begin
  1236.   Result := 0;
  1237.   if PrinterSelected then
  1238.     Result := PixelsPerInchY(GetHandle);
  1239. end;
  1240.  
  1241.  
  1242. procedure TGmPrinter.NewPage(Orientation: TGmOrientation);
  1243. var
  1244.   Device : array[0..MAX_PATH] of char;
  1245.   Driver : array[0..MAX_PATH] of char;
  1246.   Port   : array[0..MAX_PATH] of char;
  1247.   hDeviceMode: THandle;
  1248.   pDevMode: PDeviceMode;
  1249. begin
  1250.   if (PrinterSelected) and (FPrinting) then
  1251.   begin
  1252.     Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
  1253.     pDevMode := GlobalLock( hDevicemode );
  1254.     with pDevMode^ do
  1255.     begin
  1256.       dmFields := dmFields or DM_ORIENTATION;
  1257.       case Orientation of
  1258.         gmPortrait  : dmOrientation := DMORIENT_PORTRAIT;
  1259.         gmLandscape : dmOrientation := DMORIENT_LANDSCAPE;
  1260.       end;
  1261.     end;
  1262.     Windows.EndPage( Printer.Handle );
  1263.     ResetDC( canvas.Handle, pDevMode^ );
  1264.     GlobalUnlock( hDeviceMode );
  1265.     Windows.StartPage( Printer.Handle );
  1266.     Printer.Canvas.Refresh;
  1267.   end;
  1268. end;
  1269.  
  1270. procedure TGmPrinter.ResetPrinter;
  1271. var
  1272.     Device, Driver, Port: array[0..80] of Char;
  1273.     DevMode: THandle;
  1274. begin
  1275.   if PrinterSelected then
  1276.   begin
  1277.     Printer.GetPrinter(Device, Driver, Port, DevMode);
  1278.     Printer.SetPrinter(Device, Driver, Port, 0);
  1279.     UpdatePrinterMargins;
  1280.   end;
  1281. end;
  1282.  
  1283. function TGmPrinter.GetCanvas: TCanvas;
  1284. begin
  1285.   if FPrinting then Result := Printer.Canvas else Result := nil;
  1286. end;
  1287.  
  1288. function TGmPrinter.GetDitherType: TGmDitherType;
  1289. var
  1290.   Device : array[0..MAX_PATH] of char;
  1291.   Driver : array[0..MAX_PATH] of char;
  1292.   Port   : array[0..MAX_PATH] of char;
  1293.   hDMode : THandle;
  1294.   PDMode : PDEVMODE;
  1295. begin
  1296.   Printer.PrinterIndex := Printer.PrinterIndex;
  1297.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1298.   Result := gmNone;
  1299.   if hDMode <> 0 then
  1300.   begin
  1301.     pDMode := GlobalLock(hDMode);
  1302.     if pDMode <> nil then
  1303.     begin
  1304.       //if (pDMode^.dmFields and dm_Color) = dm_Color then
  1305.       //begin
  1306.       case pDMode^.dmDitherType of
  1307.          DMDITHER_NONE      : Result := gmNone;
  1308.          DMDITHER_COARSE    : Result := gmCourse;
  1309.          DMDITHER_FINE      : Result := gmFine;
  1310.          DMDITHER_LINEART   : Result := gmLineArt;
  1311.          DMDITHER_GRAYSCALE : Result := gmGrayScale;
  1312.       end;
  1313.       GlobalUnlock(hDMode);
  1314.       Printer.PrinterIndex := Printer.PrinterIndex;
  1315.     end;
  1316.   end;
  1317. end;
  1318.  
  1319. function TGmPrinter.GetDuplexType: TGmDuplexType;
  1320. var
  1321.   Device : array[0..MAX_PATH] of char;
  1322.   Driver : array[0..MAX_PATH] of char;
  1323.   Port   : array[0..MAX_PATH] of char;
  1324.   hDMode : THandle;
  1325.   PDMode : PDEVMODE;
  1326. begin
  1327.   Printer.PrinterIndex := Printer.PrinterIndex;
  1328.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1329.   Result := gmSimplex;
  1330.   if hDMode <> 0 then
  1331.   begin
  1332.     pDMode := GlobalLock(hDMode);
  1333.     if pDMode <> nil then
  1334.     begin
  1335.       case pDMode^.dmDuplex of
  1336.          DMDUP_SIMPLEX    : Result := gmSimplex;
  1337.          DMDUP_HORIZONTAL : Result := gmHorzDuplex;
  1338.          DMDUP_VERTICAL   : Result := gmVertDuplex;
  1339.       end;
  1340.       GlobalUnlock(hDMode);
  1341.       Printer.PrinterIndex := Printer.PrinterIndex;
  1342.     end;
  1343.   end;
  1344. end;
  1345.  
  1346. function TGmPrinter.GetIndexOf(APrinter: string): integer;
  1347. begin
  1348.   Result := FPrinterNames.IndexOf(APrinter);
  1349. end;
  1350.  
  1351. function TGmPrinter.GetIsColorPrinter : Boolean;
  1352. var
  1353.   Device : array[0..MAX_PATH] of char;
  1354.   Driver : array[0..MAX_PATH] of char;
  1355.   Port   : array[0..MAX_PATH] of char;
  1356.   hDMode : THandle;
  1357.   PDMode : PDEVMODE;
  1358. begin
  1359.   Result := False;
  1360.   Printer.PrinterIndex := Printer.PrinterIndex;
  1361.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1362.   if hDMode <> 0 then
  1363.   begin
  1364.     pDMode := GlobalLock(hDMode);
  1365.     if pDMode <> nil then
  1366.     begin
  1367.       if ((pDMode^.dmFields and dm_Color) = dm_Color) then
  1368.       begin
  1369.         Result := True;
  1370.       end;
  1371.       GlobalUnlock(hDMode);
  1372.     end;
  1373.   end;
  1374. end;
  1375.  
  1376. function TGmPrinter.GetPrintColorMode: TGmPrintColor;
  1377. var
  1378.   Device : array[0..MAX_PATH] of char;
  1379.   Driver : array[0..MAX_PATH] of char;
  1380.   Port   : array[0..MAX_PATH] of char;
  1381.   hDMode : THandle;
  1382.   PDMode : PDEVMODE;
  1383. begin
  1384.   Printer.PrinterIndex := Printer.PrinterIndex;
  1385.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1386.   Result := gmMonochrome;
  1387.   if hDMode <> 0 then
  1388.   begin
  1389.     pDMode := GlobalLock(hDMode);
  1390.     if pDMode <> nil then
  1391.     begin
  1392.       //if (pDMode^.dmFields and dm_Color) = dm_Color then
  1393.       //begin
  1394.       case pDMode^.dmColor of
  1395.         DMCOLOR_COLOR     : Result := gmColor;
  1396.         DMCOLOR_MONOCHROME: Result := gmMonochrome;
  1397.       end;
  1398.       GlobalUnlock(hDMode);
  1399.       Printer.PrinterIndex := Printer.PrinterIndex;
  1400.     end;
  1401.   end;
  1402. end;
  1403.  
  1404. function TGmPrinter.GetPrinterIndex: integer;
  1405. begin
  1406.   Result := -1;
  1407.   if PrinterSelected then
  1408.     Result := Printer.PrinterIndex;
  1409. end;
  1410.  
  1411. function TGmPrinter.GetPrinters: TStrings;
  1412. var
  1413.   LineCur, Port: PChar;
  1414.   Buffer, PrinterInfo: PChar;
  1415.   Flags, Count, NumInfo: DWORD;
  1416.   I: Integer;
  1417.   Level: Byte;
  1418.   ServerText: string;
  1419. begin
  1420.   if FPrinterNames = nil then
  1421.     FPrinterNames := TStringList.Create;
  1422.   FPrinterNames.Clear;
  1423.     Result := FPrinterNames;
  1424.     try
  1425.       if Win32Platform = VER_PLATFORM_WIN32_NT then
  1426.       begin
  1427.         Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
  1428.         Level := 4;
  1429.       end
  1430.       else
  1431.       begin
  1432.         Flags := PRINTER_ENUM_LOCAL;
  1433.         Level := 5;
  1434.       end;
  1435.       Count := 0;
  1436.       EnumPrinters(Flags, nil, Level, nil, 0, Count, NumInfo);
  1437.       if Count = 0 then Exit;
  1438.       GetMem(Buffer, Count);
  1439.       try
  1440.         if not EnumPrinters(Flags, nil, Level, PByte(Buffer), Count, Count, NumInfo) then
  1441.           Exit;
  1442.         PrinterInfo := Buffer;
  1443.         for I := 0 to NumInfo - 1 do
  1444.         begin
  1445.           if Level = 4 then
  1446.             with PPrinterInfo4(PrinterInfo)^ do
  1447.             begin
  1448.               if FShowServer = True then ServerText := pServerName else ServerText := '';
  1449.               FPrinterNames.AddObject(ServerText + pPrinterName,
  1450.                                       TPrinterDevice.Create(nil, pPrinterName, nil));
  1451.               Inc(PrinterInfo, sizeof(TPrinterInfo4));
  1452.             end
  1453.           else
  1454.             with PPrinterInfo5(PrinterInfo)^ do
  1455.             begin
  1456.               LineCur := pPortName;
  1457.               Port := FetchStr(LineCur);
  1458.               while Port^ <> #0 do
  1459.               begin
  1460.                 //if FShowServer = True then ServerText := pPortName else ServerText := '';
  1461.                 FPrinterNames.AddObject(Format(SDeviceOnPort, [pPrinterName, Port]),
  1462.                                     TPrinterDevice.Create(nil, pPrinterName, Port));
  1463.                 Port := FetchStr(LineCur);
  1464.               end;
  1465.               Inc(PrinterInfo, sizeof(TPrinterInfo5));
  1466.             end;
  1467.         end;
  1468.       finally
  1469.         FreeMem(Buffer, Count);
  1470.       end;
  1471.     except
  1472.       FPrinterNames.Free;
  1473.       FPrinterNames := nil;
  1474.       raise;
  1475.     end;
  1476.   Result := FPrinterNames;
  1477. end;
  1478.  
  1479. function TGmPrinter.GetOffset: TPoint;
  1480. begin
  1481.   // get the offset as printer pixels...
  1482.   Result.x := 0;
  1483.   Result.y := 0;
  1484.   if PrinterSelected then
  1485.   begin
  1486.     Result.x := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  1487.     Result.y := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
  1488.   end;
  1489. end;
  1490.  
  1491. function TGmPrinter.GetOrientation: TGmOrientation;
  1492. begin
  1493.   Result := gmPortrait;
  1494.   if PrinterSelected then
  1495.   case Printer.Orientation of
  1496.     poPortrait  : Result := gmPortrait;
  1497.     poLandscape : Result := gmLandscape;
  1498.   end;
  1499. end;
  1500.  
  1501. function TGmPrinter.GetPrinterBins: TStrings;
  1502. var
  1503.   Device, Driver, Port: array[0..80] of Char;
  1504.   p : array[0..255] of Char;
  1505.   ICount: Integer;
  1506.   {$IFDEF VER100}
  1507.   FHandle: Integer;
  1508.   {$ELSE}
  1509.   FHandle: Cardinal;
  1510.   {$ENDIF}
  1511. begin
  1512.   if not Assigned(FPrinterBins) then
  1513.     FPrinterBins := TStringList.Create;
  1514.   FPrinterBins.Clear;
  1515.   if PrinterSelected then
  1516.   begin
  1517.     Printer.GetPrinter(Device, Driver, Port, FHandle);
  1518.     with FPrinterBins do begin
  1519.       for ICount:=1 to DeviceCapabilities(Device,Port,DC_BINNAMES,p,nil) do
  1520.         Add(p+24*(ICount-1));
  1521.     end;
  1522.   end;
  1523.   Result := FPrinterBins;
  1524. end;
  1525.  
  1526. function TGmPrinter.GetPrinterBinIndex: integer;
  1527. var
  1528.   DevMode: PDevMode;
  1529.   FDevice:     array[0..255] of Char;
  1530.   FDriver:     array[0..255] of Char;
  1531.   FPort:       array[0..255] of Char;
  1532.   {$IFDEF VER100}
  1533.   FHandle: Integer;
  1534.   {$ELSE}
  1535.   FHandle: Cardinal;
  1536.   {$ENDIF}
  1537. begin
  1538.   Result := -1;
  1539.   if PrinterSelected then
  1540.   begin
  1541.     Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
  1542.     DevMode := GlobalLock(FHandle);
  1543.     with DevMode^ do
  1544.       Result := dmDefaultSource;
  1545.     GlobalUnlock(FHandle);
  1546.   end;
  1547. end;
  1548.  
  1549. function TGmPrinter.GetPrinterInstalled: Boolean;
  1550. begin
  1551.   Result := Printer.Printers.Count > 0;
  1552. end;
  1553.  
  1554. function TGmPrinter.GetPrinterMargin(index: integer): TGmValue;
  1555. var
  1556.   Offset: TPoint;
  1557.   PpiX, PpiY: integer;
  1558. begin
  1559.   Result := FValue;
  1560.   // returns the 4 printer margins as inches...
  1561.   Result.AsUnits := 0;
  1562.   if PrinterSelected then
  1563.   begin
  1564.     PpiX := PixelsPerInchX(Printer.Handle);
  1565.     PpiY := PixelsPerInchY(Printer.Handle);
  1566.     Offset := GetOffset;
  1567.     case Index of
  1568.       0: Result.AsPixels[PpiX] := Round(Offset.x);
  1569.       1: Result.AsPixels[PpiY] := Round(Offset.y);
  1570.       2: Result.AsPixels[PpiX] := Round(Offset.x);
  1571.       3: Result.AsPixels[PpiY] := Round(Offset.y);
  1572. //      1: Result.AsInches := Offset.y / PpiY;
  1573. //      2: Result.AsInches := ((PrinterWidth.AsInches - AvailableWidth.AsInches)+Offset.X))/PpiX;
  1574.  //     3: Result.AsInches := ((PrinterHeight.AsInches - AvailableHeight.AsInches)+Offset.Y))/PpiY;
  1575.     end;
  1576.   end;
  1577. end;
  1578.  
  1579. function TGmPrinter.GetPrinterSelected: Boolean;
  1580. begin
  1581.   Result := False;
  1582.   if GetPrinterInstalled then
  1583.     Result := True;
  1584. end;
  1585.  
  1586.  
  1587. function TGmPrinter.GetTitle: string;
  1588. begin
  1589.   Result := '';
  1590.   if PrinterSelected then
  1591.     Result := Printer.Title;
  1592. end;
  1593.  
  1594. procedure TGmPrinter.SetDitherType(ADitherType: TGmDitherType);
  1595. var
  1596.   Device : array[0..MAX_PATH] of char;
  1597.   Driver : array[0..MAX_PATH] of char;
  1598.   Port   : array[0..MAX_PATH] of char;
  1599.   hDMode : THandle;
  1600.   PDMode : PDEVMODE;
  1601. begin
  1602.   Printer.PrinterIndex := Printer.PrinterIndex;
  1603.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1604.   if hDMode <> 0 then
  1605.   begin
  1606.     pDMode := GlobalLock(hDMode);
  1607.     if pDMode <> nil then
  1608.       begin
  1609.         case ADitherType of
  1610.           gmNone      : pDMode^.dmDitherType := DMDITHER_NONE;
  1611.           gmCourse    : pDMode^.dmDitherType := DMDITHER_COARSE;
  1612.           gmFine      : pDMode^.dmDitherType := DMDITHER_FINE;
  1613.           gmLineArt   : pDMode^.dmDitherType := DMDITHER_LINEART;
  1614.           gmGrayScale : pDMode^.dmDitherType := DMDITHER_GRAYSCALE;
  1615.         end;
  1616.       GlobalUnlock(hDMode);
  1617.       Printer.PrinterIndex := Printer.PrinterIndex;
  1618.     end;
  1619.   end;
  1620. end;
  1621.  
  1622. procedure TGmPrinter.SetDuplexType(ADuplexType: TGmDuplexType);
  1623. var
  1624.   Device : array[0..MAX_PATH] of char;
  1625.   Driver : array[0..MAX_PATH] of char;
  1626.   Port   : array[0..MAX_PATH] of char;
  1627.   hDMode : THandle;
  1628.   PDMode : PDEVMODE;
  1629. begin
  1630.   Printer.PrinterIndex := Printer.PrinterIndex;
  1631.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1632.   if hDMode <> 0 then
  1633.   begin
  1634.     pDMode := GlobalLock(hDMode);
  1635.     if pDMode <> nil then
  1636.       begin
  1637.         case ADuplexType of
  1638.           gmSimplex     : pDMode^.dmDuplex     := DMDUP_SIMPLEX;
  1639.           gmHorzDuplex  : pDMode^.dmDitherType := DMDUP_HORIZONTAL;
  1640.           gmVertDuplex  : pDMode^.dmDitherType := DMDUP_VERTICAL;
  1641.         end;
  1642.       GlobalUnlock(hDMode);
  1643.       Printer.PrinterIndex := Printer.PrinterIndex;
  1644.     end;
  1645.   end;
  1646. end;
  1647.  
  1648. procedure TGmPrinter.SetOrientation(AOrientation: TGmOrientation);
  1649.  
  1650.   function GmOrientationToPrinterOrientation(AValue: TGmOrientation): TPrinterOrientation;
  1651.   begin
  1652.     Result := poPortrait;
  1653.     if AValue = gmLandScape then Result := poPortrait;
  1654.   end;
  1655.  
  1656. begin
  1657.   if PrinterSelected then
  1658.   begin
  1659.     if Printer.Orientation <> GmOrientationToPrinterOrientation(AOrientation) then
  1660.       Printer.Orientation := GmOrientationToPrinterOrientation(AOrientation);
  1661.   end;
  1662. end;
  1663.  
  1664. procedure TGmPrinter.SetPrinterColorMode(AColor : TGmPrintColor);
  1665. var
  1666.   Device : array[0..MAX_PATH] of char;
  1667.   Driver : array[0..MAX_PATH] of char;
  1668.   Port   : array[0..MAX_PATH] of char;
  1669.   hDMode : THandle;
  1670.   PDMode : PDEVMODE;
  1671. begin
  1672.   Printer.PrinterIndex := Printer.PrinterIndex;
  1673.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1674.   if hDMode <> 0 then
  1675.   begin
  1676.     pDMode := GlobalLock(hDMode);
  1677.     if pDMode <> nil then
  1678.     begin
  1679.       if (pDMode^.dmFields and dm_Color) = dm_Color then
  1680.       begin
  1681.         case AColor of
  1682.           gmColor     : pDMode^.dmColor := DMCOLOR_COLOR;
  1683.           gmMonochrome: pDMode^.dmColor := DMCOLOR_MONOCHROME;
  1684.         end;
  1685.       end;
  1686.       GlobalUnlock(hDMode);
  1687.       Printer.PrinterIndex := Printer.PrinterIndex;
  1688.     end;
  1689.   end;
  1690. end;
  1691.  
  1692.  
  1693. procedure TGmPrinter.SetPrinterIndex(index: integer);
  1694. begin
  1695.   if PrinterSelected then
  1696.   begin
  1697.     if index <> PrinterIndex then
  1698.     begin
  1699.       Printer.PrinterIndex := Index;
  1700.       ResetPrinter;
  1701.       if Assigned(FPreview.OnChangePrinter) then FPreview.OnChangePrinter(Self);
  1702.     end;
  1703.   end
  1704.   else
  1705.     ShowGmError(FPreview, NO_PRINTER_SELECTED);
  1706. end;
  1707.  
  1708. procedure TGmPrinter.SetPrinterBinIndex(index: integer);
  1709. var
  1710.   DevMode: PDevMode;
  1711.   FDevice:     array[0..255] of Char;
  1712.   FDriver:     array[0..255] of Char;
  1713.   FPort:       array[0..255] of Char;
  1714.   {$IFDEF VER100}
  1715.   FHandle: Integer;
  1716.   {$ELSE}
  1717.   FHandle: Cardinal;
  1718.   {$ENDIF}
  1719. begin
  1720.   if PrinterSelected then
  1721.   begin
  1722.     Printer.GetPrinter(FDevice, FDriver, FPort, FHandle);
  1723.     DevMode := GlobalLock(FHandle);
  1724.     with DevMode^ do
  1725.     begin
  1726.       dmFields := DM_DEFAULTSOURCE;
  1727.       dmDefaultSource := Index;
  1728.     end;
  1729.     GlobalUnlock(FHandle);
  1730.   end
  1731.   else
  1732.     ShowGmError(FPreview, NO_PRINTER_SELECTED);
  1733. end;
  1734.  
  1735. procedure TGmPrinter.SetPrintQuality(AQuality: TGmPrintQuality);
  1736. var
  1737.   Device : array[0..MAX_PATH] of char;
  1738.   Driver : array[0..MAX_PATH] of char;
  1739.   Port   : array[0..MAX_PATH] of char;
  1740.   hDMode : THandle;
  1741.   PDMode : PDEVMODE;
  1742. begin
  1743.   Printer.PrinterIndex := Printer.PrinterIndex;
  1744.   Printer.GetPrinter(Device, Driver, Port, hDMode);
  1745.   if hDMode <> 0 then
  1746.   begin
  1747.     pDMode := GlobalLock(hDMode);
  1748.     if pDMode <> nil then
  1749.     begin
  1750.       if (pDMode^.dmFields and dm_printquality) = dm_printquality then
  1751.       begin
  1752.         case AQuality of
  1753.           gmDraft : pDMode^.dmPrintQuality := Short(DMRES_DRAFT);
  1754.           gmLow   : pDMode^.dmPrintQuality := Short(DMRES_LOW);
  1755.           gmMedium: pDMode^.dmPrintQuality := Short(DMRES_MEDIUM);
  1756.           gmHigh  : pDMode^.dmPrintQuality := Short(DMRES_HIGH);
  1757.         end;
  1758.       end;
  1759.       GlobalUnlock(hDMode);
  1760.       Printer.PrinterIndex := Printer.PrinterIndex;
  1761.     end;
  1762.   end;
  1763. end;
  1764.  
  1765. procedure TGmPrinter.SetShowServer(AValue: Boolean);
  1766. begin
  1767.   FShowServer := AValue;
  1768. end;
  1769.  
  1770. procedure TGmPrinter.SetTitle(ATitle: string);
  1771. begin
  1772.   if (PrinterSelected) and (not FPrinting) then
  1773.     Printer.Title := ATitle;
  1774. end;
  1775.  
  1776. procedure TGmPrinter.UpdatePrinterMargins;
  1777. begin
  1778.   FPrinterMargins.Left.AsUnits    := GetPrinterMargin(0).AsUnits;
  1779.   FPrinterMargins.Top.AsUnits     := GetPrinterMargin(1).AsUnits;
  1780.   FPrinterMargins.Right.AsUnits   := GetPrinterMargin(2).AsUnits;
  1781.   FPrinterMargins.Bottom.AsUnits  := GetPrinterMargin(3).AsUnits;
  1782.   //FillGmUnits(FPrinterMargins.Left);
  1783.   //FillGmUnits(FPrinterMargins.Right);
  1784.   //FillGmUnits(FPrinterMargins.Top);
  1785.   //FillGmUnits(FPrinterMargins.Bottom);
  1786. end;
  1787.  
  1788. constructor TPrinterDevice.Create(ADriver, ADevice, APort: PChar);
  1789. begin
  1790.   inherited Create;
  1791.   Driver := ADriver;
  1792.   Device := ADevice;
  1793.   Port := APort;
  1794. end;
  1795.  
  1796. //------------------------------------------------------------------------------
  1797.  
  1798. // *** TGmCanvas ***
  1799.  
  1800. constructor TGmCanvas.Create(AOwner: TGmPreview);
  1801. begin
  1802.   inherited Create;
  1803.   FPreview := AOwner;
  1804.   FBrush  := TBrush.Create;
  1805.   FCopyMode := cmSrcCopy;
  1806.   FDefaultMeasurement := GmMillimeters;
  1807.   FFont   := TFont.Create;
  1808.   FPen    := TPen.Create;
  1809.   FTempMetafile := TMetafile.Create;
  1810.   FTempCanvas   := TMetafileCanvas.Create(FTempMetafile, 0);
  1811.   FCoordsRelative := fromPage;
  1812.   FFont.Name := DEFAULT_FONT;
  1813.   FValue1 := TGmValue.Create;
  1814.   FValue2 := TGmValue.Create;
  1815.   FSavedPen := TPen.Create;
  1816.   FSavedBrush := TBrush.Create;
  1817. end;
  1818.  
  1819. destructor TGmCanvas.Destroy;
  1820. begin
  1821.   FBrush.Free;
  1822.   FTempCanvas.Free;
  1823.   FTempMetafile.Free;
  1824.   FFont.Free;
  1825.   FPen.Free;
  1826.   FValue1.Free;
  1827.   FValue2.Free;
  1828.   FSavedPen.Free;
  1829.   FSavedBrush.Free;
  1830.   inherited Destroy;
  1831. end;
  1832.  
  1833. function TGmCanvas.GraphicHeight(AGraphic: TGraphic): TGmValue;
  1834. begin
  1835.   Result := FValue1;
  1836.   FValue1.AsPixels[ScreenPpi] := AGraphic.Height;
  1837. end;
  1838.  
  1839. function TGmCanvas.GraphicWidth(AGraphic: TGraphic): TGmValue;
  1840. begin
  1841.   Result := FValue1;
  1842.   FValue1.AsPixels[ScreenPpi] := AGraphic.Width;
  1843. end;
  1844.  
  1845. function TGmCanvas.TextHeight(AText: string): TGmValue;
  1846. begin
  1847.   // work out height and pass back a TGmValue record type...
  1848.   Result := FValue1;
  1849.   FTempCanvas.Font.Assign(FFont);
  1850.   Result.AsPixels[ScreenPpi] := FTempCanvas.TextHeight(AText);
  1851. end;
  1852.  
  1853. function TGmCanvas.TextWidth(AText: string): TGmValue;
  1854. begin
  1855.   // work out height and pass back a TGmValue record type...
  1856.   Result := FValue1;
  1857.   FTempCanvas.Font.Assign(FFont);
  1858.   Result.AsPixels[ScreenPpi] := FTempCanvas.TextWidth(AText);
  1859. end;
  1860.  
  1861. {procedure TGmCanvas.BrushChange(Sender: TObject);
  1862. begin
  1863.   FCanvas.Brush.Assign(FBrush);
  1864. end;
  1865.  
  1866. procedure TGmCanvas.FontChange(Sender: TObject);
  1867. begin
  1868.   FCanvas.Font.Assign(FFont);
  1869. end;
  1870.  
  1871. procedure TGmCanvas.PenChange(Sender: TObject);
  1872. begin
  1873.   FCanvas.Pen.Assign(FPen);
  1874. end; }
  1875.  
  1876. procedure TGmCanvas.Arc(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);
  1877. var
  1878.   AArcShape: TGmArcShape;
  1879. begin
  1880.   // Create an Ellipse object and add it to the page objects list...
  1881.   AArcShape := TGmArcShape.Create;
  1882.   AArcShape.Brush := BrushToGmBrush(FBrush);
  1883.   AArcShape.Pen   := PenToGmPen(FPen);
  1884.   AArcShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits))+ GetLeft;
  1885.   AArcShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  1886.   AArcShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits))+ GetLeft;
  1887.   AArcShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  1888.   AArcShape.X3    := Round(ConvertValue(x3, GmMeasurement, GmUnits))+ GetLeft;
  1889.   AArcShape.Y3    := Round(ConvertValue(y3, GmMeasurement, GmUnits)) + GetTop;
  1890.   AArcShape.X4    := Round(ConvertValue(x4, GmMeasurement, GmUnits))+ GetLeft;
  1891.   AArcShape.Y4    := Round(ConvertValue(y4, GmMeasurement, GmUnits)) + GetTop;
  1892.   FPage.AddObject(AArcShape);
  1893. end;
  1894.  
  1895. procedure TGmCanvas.Chord(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);
  1896. var
  1897.   AChordShape: TGmChordShape;
  1898. begin
  1899.   // Create an Ellipse object and add it to the page objects list...
  1900.   AChordShape := TGmChordShape.Create;
  1901.   AChordShape.Brush := BrushToGmBrush(FBrush);
  1902.   AChordShape.Pen   := PenToGmPen(FPen);
  1903.   AChordShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits))+ GetLeft;;
  1904.   AChordShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  1905.   AChordShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits))+ GetLeft;;
  1906.   AChordShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  1907.   AChordShape.X3    := Round(ConvertValue(x3, GmMeasurement, GmUnits))+ GetLeft;;
  1908.   AChordShape.Y3    := Round(ConvertValue(y3, GmMeasurement, GmUnits)) + GetTop;
  1909.   AChordShape.X4    := Round(ConvertValue(x4, GmMeasurement, GmUnits))+ GetLeft;;
  1910.   AChordShape.Y4    := Round(ConvertValue(y4, GmMeasurement, GmUnits)) + GetTop;
  1911.   FPage.AddObject(AChordShape);
  1912. end;
  1913.  
  1914. procedure TGmCanvas.Draw(x, y: Extended; AGraphic: TGraphic; Scale: Extended; GmMeasurement: TGmMeasurement);
  1915. var
  1916.   ARect: TRect;
  1917. begin
  1918.     ARect.Left    := Round(ConvertValue(x, GmMeasurement, GmUnits))+ GetLeft;;
  1919.     ARect.Top     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  1920.     ARect.Right   := Round(ConvertValue(x, GmMeasurement, GmUnits))+ Round(GraphicWidth(AGraphic).AsUnits*Scale)+ GetLeft;;
  1921.     ARect.Bottom  := Round(ConvertValue(y, GmMeasurement, GmUnits))+ Round(GraphicHeight(AGraphic).AsUnits*Scale) + GetTop;
  1922.     StretchDraw(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, AGraphic, GmUnits);
  1923.     CanvasChanged;
  1924. end;
  1925.  
  1926. function TGmCanvas.GetLeft: integer;
  1927. var
  1928.   APreview: TGmPreview;
  1929. begin
  1930.   APreview := FPage.FPreview;
  1931.   case FCoordsRelative of
  1932.     fromPrinterMargins: Result := APreview.GmPrinter.PrinterMargins.Left.AsUnits;
  1933.     fromUserMargins:    Result := APreview.Margins.Left.AsUnits;
  1934.     fromHeaderLine:     Result := APreview.Margins.Left.AsUnits;
  1935.   else
  1936.     Result := 0;
  1937.   end;
  1938. end;
  1939.  
  1940. procedure TGmCanvas.CanvasChanged;
  1941. begin
  1942.   if Assigned(FPreview.OnCanvasChange) then FPreview.OnCanvasChange(Self);
  1943. end;
  1944.  
  1945. function TGmCanvas.GetTop: integer;
  1946. var
  1947.   APreview: TGmPreview;
  1948. begin
  1949.   APreview := FPage.FPreview;
  1950.   case FCoordsRelative of
  1951.     fromPrinterMargins: Result := APreview.GmPrinter.PrinterMargins.Top.AsUnits;
  1952.     fromUserMargins:    Result := APreview.Margins.Top.AsUnits;
  1953.     fromHeaderLine:     Result := APreview.Margins.Top.AsUnits + APreview.Header.Height.AsUnits;
  1954.   else
  1955.     Result := 0;
  1956.   end;
  1957. end;
  1958.  
  1959. procedure TGmCanvas.DrawRect(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement; RectType: TGmRectType);
  1960. var
  1961.   ARectangleShape: TGmRectangleShape;
  1962. begin
  1963.   // Create a rectangle object and add it to the page objects list...
  1964.   ARectangleShape := TGmRectangleShape.Create;
  1965.   ARectangleShape.Brush   := BrushToGmBrush(FBrush);
  1966.   ARectangleShape.Pen     := PenToGmPen(FPen);
  1967.   ARectangleShape.X       := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;
  1968.   ARectangleShape.Y       := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  1969.   ARectangleShape.X2      := Round(ConvertValue(x2, GmMeasurement, GmUnits))+ GetLeft;
  1970.   ARectangleShape.Y2      := Round(ConvertValue(y2, GmMeasurement, GmUnits))+ GetTop;
  1971.   ARectangleShape.RectType:= RectType;
  1972.   FPage.AddObject(ARectangleShape);
  1973. end;
  1974.  
  1975. procedure TGmCanvas.Ellipse(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  1976. var
  1977.   AEllipseShape: TGmEllipseShape;
  1978. begin
  1979.   // Create an Ellipse object and add it to the page objects list...
  1980.   AEllipseShape := TGmEllipseShape.Create;
  1981.   AEllipseShape.Brush := BrushToGmBrush(FBrush);
  1982.   AEllipseShape.Pen   := PenToGmPen(FPen);
  1983.   AEllipseShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits))+ GetLeft;;
  1984.   AEllipseShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  1985.   AEllipseShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits))+ GetLeft;;
  1986.   AEllipseShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  1987.   FPage.AddObject(AEllipseShape);
  1988. end;
  1989.  
  1990. procedure TGmCanvas.FillRect(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  1991. begin
  1992.   DrawRect(x, y, x2, y2, GmMeasurement, gmFillRect);
  1993. end;
  1994.  
  1995.  
  1996. procedure TGmCanvas.FloatOut(x, y, AValue: Extended; Format: string; GmMeasurement: TGmMeasurement);
  1997. var
  1998.   ATextObject: TGmTextObject;
  1999.   //Unused : Extended;
  2000. begin
  2001.   // create a text object and set its values...
  2002.   ATextObject := TGmTextObject.Create;
  2003.   ATextObject.Caption := FormatFloat(Format, AValue);
  2004.  
  2005.   x  := (ConvertValue(x, GmMeasurement, GmUnits)- TextWidth(ATextObject.Caption).AsUnits) + GetLeft;;
  2006.   y  := ConvertValue(y, GmMeasurement, GmUnits) + GetTop;
  2007.  
  2008.   ATextObject.X  := Round(x);
  2009.   ATextObject.Y  := Round(y);
  2010.   ATextObject.Brush := BrushToGmBrush(FBrush);
  2011.   ATextObject.Font := FontToGmFont(FFont);
  2012.   FPage.AddObject(ATextObject);
  2013. end;
  2014.  
  2015. procedure TGmCanvas.Line(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  2016. var
  2017.   ALineObject: TGmLineObject;
  2018. begin
  2019.   ALineObject       := TGmLineObject.Create;
  2020.   ALineObject.Pen   := PenToGmPen(FPen);
  2021.   ALineObject.X     := Round(ConvertValue(x, GmMeasurement, GmUnits))+ GetLeft;;
  2022.   ALineObject.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2023.   ALineObject.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits))+ GetLeft;;
  2024.   ALineObject.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  2025.   FPage.AddObject(ALineObject);
  2026. end;
  2027.  
  2028. procedure TGmCanvas.LineExt(x, y, x2, y2: Extended; LineWidth: Integer; GmMeasurement: TGmMeasurement);
  2029. begin
  2030.   { TODO : line thickness }
  2031.   Line(x, y, x2, y2, GmMeasurement);
  2032. end;
  2033.  
  2034. procedure TGmCanvas.LineTo(x, y: Extended; GmMeasurement: TGmMeasurement);
  2035. begin
  2036.   x := ConvertValue(x, GmMeasurement, GmUnits);
  2037.   y := ConvertValue(y, GmMeasurement, GmUnits);
  2038.   Line(FCurrentPos.X, FCurrentPos.Y, x, y, GmUnits);
  2039.   FCurrentPos.X := Round(x);
  2040.   FCurrentPos.Y := Round(y);
  2041. end;
  2042.  
  2043. procedure TGmCanvas.MoveTo(x, y: Extended; GmMeasurement: TGmMeasurement);
  2044. begin
  2045.   FCurrentPos.X := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;;
  2046.   FCurrentPos.Y := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2047. end;
  2048.  
  2049. procedure TGmCanvas.Pie(x, y, x2, y2, x3, y3, x4, y4: Extended; GmMeasurement: TGmMeasurement);
  2050. var
  2051.   APieShape: TGmPieShape;
  2052. begin
  2053.   // Create an Ellipse object and add it to the page objects list...
  2054.   APieShape := TGmPieShape.Create;
  2055.   APieShape.Brush := BrushToGmBrush(FBrush);
  2056.   APieShape.Pen   := PenToGmPen(FPen);
  2057.   APieShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;
  2058.   APieShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2059.   APieShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits)) + GetLeft;
  2060.   APieShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  2061.   APieShape.X3    := Round(ConvertValue(x3, GmMeasurement, GmUnits)) + GetLeft;
  2062.   APieShape.Y3    := Round(ConvertValue(y3, GmMeasurement, GmUnits)) + GetTop;
  2063.   APieShape.X4    := Round(ConvertValue(x4, GmMeasurement, GmUnits)) + GetLeft;
  2064.   APieShape.Y4    := Round(ConvertValue(y4, GmMeasurement, GmUnits)) + GetTop;
  2065.   FPage.AddObject(APieShape);
  2066. end;
  2067. {$IFNDEF VER100}
  2068.  
  2069. procedure TGmCanvas.Polygon(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  2070. var
  2071.   APolygonObject: TGmPolyBaseObject;
  2072.   count: integer;
  2073.   x, y: Extended;
  2074. begin
  2075.   // create a new polygon object and set its values...
  2076.   APolygonObject := TGmPolygonObject.Create;
  2077.   SetLength(APolygonObject.Points, High(Points)+1);
  2078.   for count := 0 to High(Points) do
  2079.   begin
  2080.     x := ConvertValue(Points[count].x, GmMeasurement, GmUnits) + GetLeft;
  2081.     y := ConvertValue(Points[count].y, GmMeasurement, GmUnits) + GetTop;
  2082.     APolygonObject.Points[count].x := Round(x);
  2083.     APolygonObject.Points[count].y := Round(y);
  2084.   end;
  2085.   APolygonObject.Brush  := BrushToGmBrush(FBrush);
  2086.   APolygonObject.Pen    := PenToGmPen(FPen);
  2087.   FPage.AddObject(APolygonObject);
  2088. end;
  2089.  
  2090. procedure TGmCanvas.PolyLine(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  2091. var
  2092.   APolylineObject: TGmPolyBaseObject;
  2093.   count: integer;
  2094.   x, y: Extended;
  2095. begin
  2096.   // create a new polygon object and set its values...
  2097.   APolylineObject := TGmPolyLineObject.Create;
  2098.   SetLength(APolylineObject.Points, High(Points)+1);
  2099.   for count := 0 to High(Points) do
  2100.   begin
  2101.     x := ConvertValue(Points[count].x, GmMeasurement, GmUnits) + GetLeft;
  2102.     y := ConvertValue(Points[count].y, GmMeasurement, GmUnits) + GetTop;
  2103.     APolylineObject.Points[count].x := Round(x);
  2104.     APolylineObject.Points[count].y := Round(y);
  2105.   end;
  2106.   APolylineObject.Brush  := BrushToGmBrush(FBrush);
  2107.   APolylineObject.Pen    := PenToGmPen(FPen);
  2108.   FPage.AddObject(APolylineObject);
  2109. end;
  2110.  
  2111. procedure TGmCanvas.PolyLineTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  2112. begin
  2113.   PolyLine(Points, GmMeasurement);
  2114.   FCurrentPos.x := Round(ConvertValue(Points[High(Points)].x, GmMeasurement, GmUnits)) + GetLeft;
  2115.   FCurrentPos.y := Round(ConvertValue(Points[High(Points)].y, GmMeasurement, GmUnits)) + GetTop;
  2116. end;
  2117.  
  2118. procedure TGmCanvas.PolyBezier(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  2119. var
  2120.   APolyBezierObject: TGmPolyBezierObject;
  2121.   count: integer;
  2122.   x, y: Extended;
  2123. begin
  2124.   // create a new polygon object and set its values...
  2125.   APolyBezierObject := TGmPolyBezierObject.Create;
  2126.   SetLength(APolyBezierObject.Points, High(Points)+1);
  2127.   for count := 0 to High(Points) do
  2128.   begin
  2129.     x := ConvertValue(Points[count].x, GmMeasurement, GmUnits) + GetLeft;
  2130.     y := ConvertValue(Points[count].y, GmMeasurement, GmUnits) + GetTop;
  2131.     APolyBezierObject.Points[count].x := Round(x);
  2132.     APolyBezierObject.Points[count].y := Round(y);
  2133.   end;
  2134.   APolyBezierObject.Brush  := BrushToGmBrush(FBrush);
  2135.   APolyBezierObject.Pen    := PenToGmPen(FPen);
  2136.   FPage.AddObject(APolyBezierObject);
  2137. end;
  2138.  
  2139. procedure TGmCanvas.PolyBezierTo(Points: array of TGmPoint; GmMeasurement: TGmMeasurement);
  2140. begin
  2141.   PolyBezier(Points, GmMeasurement);
  2142.   FCurrentPos.x := Round(ConvertValue(Points[High(Points)].x, GmMeasurement, GmUnits)) + GetLeft;
  2143.   FCurrentPos.y := Round(ConvertValue(Points[High(Points)].y, GmMeasurement, GmUnits)) + GetTop;
  2144. end;
  2145.  
  2146. {$ENDIF}
  2147.  
  2148. procedure TGmCanvas.Rectangle(x, y, x2, y2: Extended; GmMeasurement: TGmMeasurement);
  2149. begin
  2150.   DrawRect(x, y, x2, y2, GmMeasurement, gmRectangle);
  2151. end;
  2152.  
  2153. procedure TGmCanvas.RotateOut(x, y, Angle: Extended; AText: string; GmMeasurement: TGmMeasurement);
  2154.   procedure SetFontAngle(AFont: TFont; Angle: Extended);
  2155.   var
  2156.   logRec : TLogFont;
  2157.   begin
  2158.     GetObject(AFont.Handle, SizeOf(TLogFont), @logrec);
  2159.     logrec.lfEscapement := Round(Angle*10);
  2160.     AFont.Handle := CreateFontIndirect(logRec);
  2161.   end;
  2162. var
  2163.   ATextObject: TGmTextObject;
  2164. begin
  2165.   x  := ConvertValue(x, GmMeasurement, GmUnits) + GetLeft;
  2166.   y  := ConvertValue(y, GmMeasurement, GmUnits) + GetTop;
  2167.  
  2168.   // create a text object and set its values...
  2169.   ATextObject := TGmTextObject.Create;
  2170.   ATextObject.X  := Round(X);
  2171.   ATextObject.Y  := Round(Y);
  2172.   ATextObject.Caption := AText;
  2173.   ATextObject.Brush := BrushToGmBrush(FBrush);
  2174.   SetFontAngle(FFont, Angle);
  2175.   ATextObject.Font := FontToGmFont(FFont);
  2176.   FPage.AddObject(ATextObject);
  2177. end;
  2178.  
  2179. procedure TGmCanvas.RoundRect(x, y, x2, y2, x3, y3: Extended; GmMeasurement: TGmMeasurement);
  2180. var
  2181.   ARoundRectShape: TGmRoundRectShape;
  2182. begin
  2183.   // Create a round-rect object and add it to the page objects list...
  2184.   ARoundRectShape := TGmRoundRectShape.Create;
  2185.   ARoundRectShape.Brush := BrushToGmBrush(FBrush);
  2186.   ARoundRectShape.Pen   := PenToGmPen(FPen);
  2187.   ARoundRectShape.X     := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;
  2188.   ARoundRectShape.Y     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2189.   ARoundRectShape.X2    := Round(ConvertValue(x2, GmMeasurement, GmUnits)) + GetLeft;
  2190.   ARoundRectShape.Y2    := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  2191.   ARoundRectShape.X3    := Round(ConvertValue(x3, GmMeasurement, GmUnits));
  2192.   ARoundRectShape.Y3    := Round(ConvertValue(y3, GmMeasurement, GmUnits));
  2193.   FPage.AddObject(ARoundRectShape);
  2194. end;
  2195.  
  2196. procedure TGmCanvas.StretchDraw(x,y, x2, y2: Extended; AGraphic: TGraphic; GmMeasurement: TGmMeasurement);
  2197. var
  2198.   AObject: TGmGraphicObject;
  2199.   //Ppi: Integer;
  2200.   ConvertBmp: TBitmap;
  2201.   //Unused: Extended;
  2202.   ARect: TRect;
  2203. begin
  2204.   // create a new graphic object and set its values...
  2205.   if Assigned(AGraphic) then
  2206.   begin
  2207.     ARect.Left    := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;
  2208.     ARect.Top     := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2209.     ARect.Right   := Round(ConvertValue(x2, GmMeasurement, GmUnits)) + GetLeft;
  2210.     ARect.Bottom  := Round(ConvertValue(y2, GmMeasurement, GmUnits)) + GetTop;
  2211.  
  2212.     AObject := TGmGraphicObject.Create;
  2213.     AObject.CopyMode := FCopyMode;
  2214.     AObject.SetBounds(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  2215.  
  2216.     // create the picture and bitmap objects...
  2217.     if (AGraphic is TIcon) then
  2218.     begin
  2219.       ConvertBmp := TBitmap.Create;
  2220.       ConvertBmp.HandleType := bmDIB;
  2221.       ConvertBmp.Height := AGraphic.Height;
  2222.       ConvertBmp.Width := AGraphic.Width;
  2223.       ConvertBmp.Canvas.Draw(0, 0, AGraphic);
  2224.       AObject.Bitmap := TBitmap.Create;
  2225.       AObject.Bitmap := ConvertBmp;
  2226.       ConvertBmp.Free;
  2227.     end
  2228.     else
  2229.       if (AGraphic is TBitmap) then
  2230.         AObject.Bitmap := (AGraphic as TBitmap)
  2231.     else
  2232.       if (AGraphic is TMetafile) then
  2233.       begin
  2234.         AObject.Metafile := TMetafile.Create;
  2235.         AObject.Metafile.Assign(AGraphic);
  2236.       end;
  2237.     // add the graphic object to the current page...
  2238.     FPage.AddObject(AObject);
  2239.   end;
  2240. end;
  2241.  
  2242. function TGmCanvas.TextBox(x, y, x2, y2: Extended; AText: string;
  2243.       Alignment: TAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  2244. begin
  2245.   Result := TextBoxExt(X, Y, X2, Y2, AText, Alignment, gmTop, Draw, GmMeasurement);
  2246. end;
  2247.  
  2248. function TGmCanvas.TextBoxExt(x, y, x2, y2: Extended; AText: string;
  2249.       Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  2250. var
  2251.   ATextBox: TGmTextBoxObject;
  2252.   CalcRect: TRect;
  2253.   Ppi: integer;
  2254.   TempVal: TGmValue;
  2255. begin
  2256.   // create a textbox object and set its values...
  2257.  
  2258.   x  := ConvertValue(x,  GmMeasurement, GmUnits) + GetLeft;
  2259.   y  := ConvertValue(y,  GmMeasurement, GmUnits) + GetTop;
  2260.   x2 := ConvertValue(x2, GmMeasurement, GmUnits) + GetLeft;
  2261.   y2 := ConvertValue(y2, GmMeasurement, GmUnits) + GetTop;
  2262.  
  2263.   //Unused := 0;
  2264.  
  2265.   ATextBox := TGmTextBoxObject.Create;
  2266.   // create the textBox...
  2267.   //AObject.X  := Round(X);
  2268.   //AObject.Y  := Round(Y);
  2269.   //AObject.X2 := Round(X2);
  2270.  
  2271.   if (AText = '') and (Y2 = 0) then Y2 := Y;
  2272.   //if Y2 > 0 then
  2273.     //AObject.Y2 := Round(Y2);
  2274.  
  2275.   ATextBox.Caption := AText;
  2276.   ATextBox.Alignment := Alignment;
  2277.   ATextBox.VertAlignment := Ord(VertAlignment);
  2278.   ATextBox.Brush := BrushToGmBrush(FBrush);
  2279.   ATextBox.Font := FontToGmFont(FFont{, 0});
  2280.   ATextBox.Pen := PenToGmPen(FPen);
  2281.   //ATextBox.Page := FPreview.CurrentPage;
  2282.  
  2283.   if Y2 = 0 then
  2284.   begin
  2285.     // calculate the height of the textBox...
  2286.     Ppi := Screen.PixelsPerInch;
  2287.     CalcRect.Left   := Round(ConvertValue(x, GmUnits, GmPixels));
  2288.     CalcRect.Top    := Round(ConvertValue(y, GmUnits, GmPixels));
  2289.     CalcRect.Right  := Round(ConvertValue(x2, GmUnits, GmPixels));
  2290.  
  2291.     // this doesn't actually draw the text - it just returns the height of the text
  2292.     // as screen pixels...
  2293.     FTempCanvas.Lock;
  2294.     try
  2295.       FTempCanvas.Font := FFont;
  2296.       Windows.DrawText(FTempCanvas.Handle,
  2297.                        PChar(AText),
  2298.                        Length(AText),
  2299.                        CalcRect,
  2300.                        DT_WORDBREAK + DT_CALCRECT);
  2301.     finally
  2302.       FTempCanvas.Unlock;
  2303.     end;
  2304.     TempVal := TGmValue.Create;
  2305.     try
  2306.       TempVal.AsInches := CalcRect.Bottom / Ppi;
  2307.       Y2 := TempVal.AsUnits;
  2308.     finally
  2309.       TempVal.Free;
  2310.     end;
  2311.   end;
  2312.  
  2313.   //if FCoordsRelative <> fromPage then
  2314.     //ConvertCoords(X, Y, X2, Y2, Unused, Unused, Unused, Unused);
  2315.     ATextBox.X  := Round(x);
  2316.     ATextBox.Y  := Round(y);
  2317.     ATextBox.X2 := Round(x2);
  2318.     ATextBox.Y2 := Round(y2);
  2319.  
  2320.   Result := ConvertValue(ATextBox.y2 - ATextBox.y, GmUnits, GmMeasurement) + GetTop;
  2321.  
  2322.   if Draw then
  2323.   begin
  2324.     // add the textbox object to the current page...
  2325.     FPage.AddObject(ATextBox);
  2326.     {FLastObject := AObject;
  2327.     if Assigned(FPreview.FOnCanvasChange) then
  2328.       FPreview.FOnCanvasChange(Self);  }
  2329.   end
  2330.   else
  2331.     ATextBox.Free;
  2332. end;
  2333.  
  2334. procedure TGmCanvas.TextExtent(AText : string; var AWidth, AHeight: TGmValue);
  2335. begin
  2336.   AWidth  := FValue1;
  2337.   AHeight := FValue2;
  2338.   FValue1.AsUnits := TextWidth(AText).AsUnits;
  2339.   FValue2.AsUnits := TextHeight(AText).AsUnits;
  2340. end;
  2341.  
  2342. {$IFNDEF BCB}
  2343. procedure TGmCanvas.TextOut(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  2344. begin
  2345.   // I have added a TextOutLeft method because C++ seems to cause a fuss about using
  2346.   // the standard TextOut method !?  This will not alter any existing Delphi code...
  2347.   TextOutLeft(x, y, AText, GmMeasurement);
  2348. end;
  2349. {$ENDIF}
  2350.  
  2351. procedure TGmCanvas.TextOutLeft(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  2352. var
  2353.   ATextObject: TGmTextObject;
  2354. begin
  2355.   // Create a rectangle object and add it to the page objects list...
  2356.   ATextObject := TGmTextObject.Create;
  2357.   ATextObject.Font  := FontToGmFont(FFont{, 0});
  2358.   ATextObject.Brush := BrushToGmBrush(FBrush);
  2359.   ATextObject.X := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;
  2360.   ATextObject.Y := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2361.   ATextObject.Caption := AText;
  2362.   FPage.Add(ATextObject);
  2363. end;
  2364.  
  2365. procedure TGmCanvas.TextOutRight(x, y: Extended; AText: string; GmMeasurement: TGmMeasurement);
  2366. var
  2367.   ALeft,ATop, AWidth: Integer;
  2368. begin
  2369.   // draw right aligned text with its right side aligned to the X parameter...
  2370.   ALeft := Round(ConvertValue(x, GmMeasurement, GmUnits)) + GetLeft;
  2371.   ATop  := Round(ConvertValue(y, GmMeasurement, GmUnits)) + GetTop;
  2372.   AWidth := Textwidth(AText).AsUnits;
  2373.   TextOutLeft(ALeft-AWidth, ATop, AText, GmUnits);
  2374. end;
  2375.  
  2376. //------------------------------------------------------------------------------
  2377.  
  2378. // Overloaded canvas methods...
  2379.  
  2380. {$IFNDEF VER100}
  2381.  
  2382. procedure TGmCanvas.Ellipse(ARect: TGmRect; GmMeasurement: TGmMeasurement);
  2383. begin
  2384.   Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, GmMeasurement);
  2385. end;
  2386.  
  2387. procedure TGmCanvas.FillRect(ARect: TGmRect; GmMeasurement: TGmMeasurement);
  2388. begin
  2389.   Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, GmMeasurement);
  2390. end;
  2391.  
  2392. procedure TGmCanvas.Line(ARect: TGmRect; GmMeasurement: TGmMeasurement);
  2393. begin
  2394.   Line(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, GmMeasurement);
  2395. end;
  2396.  
  2397. procedure TGmCanvas.LineExt(ARect: TGmRect; LineWidth: integer; GmMeasurement: TGmMeasurement);
  2398. begin
  2399.   LineExt(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, LineWidth, GmMeasurement);
  2400. end;
  2401.  
  2402. procedure TGmCanvas.Rectangle(ARect: TGmRect; GmMeasurement: TGmMeasurement);
  2403. begin
  2404.   Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, GmMeasurement);
  2405. end;
  2406.  
  2407. procedure TGmCanvas.RoundRect(ARect: TGmRect; x3, y3: Extended; GmMeasurement: TGmMeasurement);
  2408. begin
  2409.   RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, x3, y3, GmMeasurement);
  2410. end;
  2411.  
  2412. function TGmCanvas.TextBox(ARect: TGmRect; AText: string;
  2413.   Alignment: TAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  2414. begin
  2415.   Result := TextBox(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, AText, Alignment, Draw, GmMeasurement);
  2416. end;
  2417.  
  2418. function TGmCanvas.TextBoxExt(ARect: TGmRect; AText: string;
  2419.   Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean; GmMeasurement: TGmMeasurement): Extended;
  2420. begin
  2421.   Result := TextBoxExt(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, AText, Alignment, VertAlignment, Draw, GmMeasurement);
  2422. end;
  2423.  
  2424. // methods which use the default measurmement parameter...
  2425.  
  2426. procedure TGmCanvas.Arc(x1, y1, x2, y2, x3, y3, x4, y4: Extended);
  2427. begin
  2428.   Arc(x1, y1, x2, y2, x3, y3, x4, y4, FDefaultMeasurement);
  2429. end;
  2430.  
  2431. procedure TGmCanvas.Chord(x1, y1, x2, y2, x3, y3, x4, y4: Extended);
  2432. begin
  2433.   Chord(x1, y1, x2, y2, x3, y3, x4, y4, FDefaultMeasurement);
  2434. end;
  2435.  
  2436. procedure TGmCanvas.Draw(x,y: double; AGraphic: TGraphic; Scale: Extended);
  2437. begin
  2438.   Draw(x, y, AGraphic, Scale, FDefaultMeasurement);
  2439. end;
  2440.  
  2441. procedure TGmCanvas.Ellipse(x, y, x2, y2: Extended);
  2442. begin
  2443.   Ellipse(x, y, x2, y2, FDefaultMeasurement);
  2444. end;
  2445.  
  2446. procedure TGmCanvas.FillRect(x, y, x2, y2: Extended);
  2447. begin
  2448.   FillRect(x, y, x2, y2, FDefaultMeasurement);
  2449. end;
  2450.  
  2451. procedure TGmCanvas.FloatOut(x, y, AValue: Extended; Format: string);
  2452. begin
  2453.   FloatOut(x, y, AValue, Format, FDefaultMeasurement);
  2454. end;
  2455.  
  2456. procedure TGmCanvas.Line(x, y, x2, y2: Extended);
  2457. begin
  2458.   Line(x, y, x2, y2, FDefaultMeasurement);
  2459. end;
  2460.  
  2461. procedure TGmCanvas.LineExt(x, y, x2, y2: Extended; LineWidth: Integer);
  2462. begin
  2463.   LineExt(x, y, x2, y2, LineWidth, FDefaultMeasurement);
  2464. end;
  2465.  
  2466. procedure TGmCanvas.Pie(x, y, x2, y2, x3, y3, x4, y4: Extended);
  2467. begin
  2468.   Pie(x, y, x2, y2, x3, y3, x4, y4, FDefaultMeasurement);
  2469. end;
  2470.  
  2471. procedure TGmCanvas.RotateOut(x, y, Angle: Extended; AText: string);
  2472. begin
  2473.   RotateOut(x, y, Angle, AText, FDefaultMeasurement);
  2474. end;
  2475.  
  2476. {$IFNDEF BCB}
  2477. procedure TGmCanvas.TextOut(x, y: Extended; AText: string);
  2478. begin
  2479.   TextOut(x, y, AText, FDefaultMeasurement);
  2480. end;
  2481.  
  2482. {$ENDIF}
  2483. procedure TGmCanvas.TextOutLeft(x, y: Extended; AText: string);
  2484. begin
  2485.   TextOutLeft(x, y, AText, FDefaultMeasurement);
  2486. end;
  2487.  
  2488. procedure TGmCanvas.TextOutRight(x, y: Extended; AText: string);
  2489. begin
  2490.   TextOutRight(x, y, AText, FDefaultMeasurement);
  2491. end;
  2492.  
  2493. function TGmCanvas.TextBox(x, y, x2, y2: Extended; AText: string;
  2494.   Alignment: TAlignment; Draw: Boolean): Extended;
  2495. begin
  2496.   Result := TextBox(x, y, x2, y2, AText, Alignment, Draw, FDefaultMeasurement);
  2497. end;
  2498.  
  2499. function TGmCanvas.TextBoxExt(x, y, x2, y2: Extended; AText: string;
  2500.   Alignment: TAlignment; VertAlignment: TGmVertAlignment; Draw: Boolean): Extended;
  2501. begin
  2502.   Result := TextBoxExt(x, y, x2, y2, AText, Alignment, VertAlignment, Draw, FDefaultMeasurement);
  2503. end;
  2504.  
  2505. procedure TGmCanvas.Rectangle(x, y, x2, y2: Extended);
  2506. begin
  2507.   Rectangle(x, y, x2, y2, FDefaultMeasurement);
  2508. end;
  2509.  
  2510. procedure TGmCanvas.RoundRect(x, y, x2, y2, x3, y3: Extended);
  2511. begin
  2512.   RoundRect(x, y, x2, y2, x3, y3, FDefaultMeasurement);
  2513. end;
  2514.  
  2515. procedure TGmCanvas.Polygon(Points: array of TGmPoint);
  2516. begin
  2517.   PolyGon(Points, FDefaultMeasurement);
  2518. end;
  2519.  
  2520. procedure TGmCanvas.PolyLine(Points: array of TGmPoint);
  2521. begin
  2522.   PolyLine(Points, FDefaultMeasurement);
  2523. end;
  2524.  
  2525. procedure TGmCanvas.PolyBezier(Points: array of TGmPoint);
  2526. begin
  2527.   PolyBezier(Points, FDefaultMeasurement);
  2528. end;
  2529.  
  2530. procedure TGmCanvas.StretchDraw(x, y, x2, y2: Extended; AGraphic: TGraphic);
  2531. begin
  2532.   StretchDraw(x, y, x2, y2, AGraphic, FDefaultMeasurement);
  2533. end;
  2534.  
  2535. {$ENDIF}
  2536.  
  2537. procedure TGmCanvas.SavePen(var Message: TMessage);
  2538. begin
  2539.   FSavedPen.Assign(FPen);
  2540. end;
  2541.  
  2542. procedure TGmCanvas.RestorePen(var Message: TMessage);
  2543. begin
  2544.   FPen.Assign(FSavedPen);
  2545. end;
  2546.  
  2547. procedure TGmCanvas.SaveBrush(var Message: TMessage);
  2548. begin
  2549.   FSavedBrush.Assign(FBrush);
  2550. end;
  2551.  
  2552. procedure TGmCanvas.RestoreBrush(var Message: TMessage);
  2553. begin
  2554.   FBrush.Assign(FSavedBrush);
  2555. end;
  2556.  
  2557. //------------------------------------------------------------------------------
  2558.  
  2559. // *** TGmPage ***
  2560.  
  2561. constructor TGmPage.Create(APreview: TGmPreview);
  2562. begin
  2563.   inherited Create;
  2564.   FPreview := APreview;
  2565.   FMetafile := TMetafile.Create;
  2566.   FOrientation := FPreview.Orientation;
  2567.   //FPaperSize := FPreview.PaperSize;
  2568. end;
  2569.  
  2570. destructor TGmPage.Destroy;
  2571. begin
  2572.   Clear;
  2573.   FMetafile.Free;
  2574.   inherited Destroy;
  2575. end;
  2576.  
  2577. {procedure TGmPage.Add(AObject: TGmBaseObject);
  2578. var
  2579.   NewObj: PGmPageObject;
  2580. begin
  2581.   New(NewObj);
  2582.   NewObj.AObject := AObject;
  2583.   Inc(FCount);
  2584.   if FStartObject <> nil then
  2585.   begin
  2586.     FObjects.NextObj := NewObj;
  2587.     NewObj.PrevObj := FObjects;
  2588.     FObjects := NewObj;
  2589.   end
  2590.   else
  2591.   begin
  2592.     FStartObject := NewObj;
  2593.     FObjects     := NewObj;
  2594.     FObjects.PrevObj := nil;
  2595.   end;
  2596.   NewObj.NextObj := nil;
  2597. end;}
  2598.  
  2599. function TGmPage.GetObject(AIndex: integer): TGmBaseObject;
  2600. {var
  2601.   CurrentObj: PGmPageObject;
  2602.   ICount: integer;        }
  2603. begin
  2604.   {CurrentObj := FStartObject;
  2605.   for ICount := 0 to AIndex-1 do
  2606.     CurrentObj := CurrentObj.NextObj;
  2607.   Result := CurrentObj.AObject;   }
  2608.    { TODO :  }
  2609.   Result :=  TGmBaseObject(Self[AIndex]);
  2610. end;
  2611.  
  2612. procedure TGmPage.SetObject(AIndex: integer; AObject: TGmBaseObject);
  2613. {var
  2614.   CurrentObj: PGmPageObject;
  2615.   ICount: integer;}
  2616. begin
  2617.  {for ICount := 0 to AIndex do
  2618.     CurrentObj := CurrentObj.NextObj;
  2619.   CurrentObj.AObject := AObject; }
  2620.   Self[AIndex] := AObject;
  2621. end;
  2622.  
  2623. procedure TGmPage.SetOrientation(AOrientation: TGmOrientation);
  2624. begin
  2625.   if FOrientation <> AOrientation then
  2626.   begin
  2627.     FOrientation := AOrientation;
  2628.     DrawPage;
  2629.     FPreview.MessageToControls(GM_UPDATE_PREVIEW, 0, 0);
  2630.     FPreview.MessageToControls(GM_PAGE_ORIENTATION_CHANGED, PageNum, 0);
  2631.     if Assigned(FPreview.OnChangePageOrientation) then
  2632.       FPreview.OnChangePageOrientation(Self, FPageNum, FOrientation);
  2633.   FPreview.PositionPage;
  2634.     //SetPaperSize(FPaperSize);
  2635.   end;
  2636. end;
  2637.  
  2638. procedure TGmPage.AddObject(AObject: TGmBaseObject);
  2639. begin
  2640.   // Add the object to the page objects list...
  2641.   Add(AObject);
  2642. end;
  2643.  
  2644. procedure TGmPage.Clear;
  2645. var
  2646.   ICount: integer;
  2647. begin
  2648.   // clear all objects from the page...
  2649.    { TODO :  }
  2650.   for ICount := Count-1 downto 0 do
  2651.     TGmBaseObject(Self[ICount]).Free;
  2652.   inherited Clear;
  2653. end;
  2654.  
  2655. procedure TGmPage.DrawPage;//(InchWidth, InchHeight: Extended);
  2656. var
  2657.   ICount: integer;
  2658.   ACanvas: TMetafileCanvas;
  2659.   Rgn: HRGN;
  2660.   W, H: Extended;
  2661.   PagePixelsWidth,
  2662.   PagePixelsHeight: integer;
  2663. begin
  2664.   // re-create the page metafile by looping through and redrawing each of the
  2665.   // objects...
  2666.   FMetafile.Clear;
  2667.     case FOrientation of
  2668.       gmPortrait:
  2669.       begin
  2670.         W := MinExt(FInchWidth, FInchHeight);
  2671.         H := MaxExt(FInchWidth, FInchHeight);
  2672.       end
  2673.       else
  2674.       begin
  2675.         W := MaxExt(FInchWidth, FInchHeight);
  2676.         H := MinExt(FInchWidth, FInchHeight);
  2677.       end;
  2678.     end;
  2679.     PagePixelsWidth   := Round(W * ScreenPpi);
  2680.     PagePixelsHeight  := Round(H * ScreenPpi);
  2681.     FMetafile.Width   := PagePixelsWidth;
  2682.     FMetafile.Height  := PagePixelsHeight;
  2683.  
  2684.   ACanvas := TMetafileCanvas.Create(FMetafile, 0);
  2685.  
  2686.   if FPreview.Margins.ClipMargins then
  2687.     Rgn := CreateRectRgn(FPreview.Margins.Left.AsPixels[ScreenPpi],
  2688.                          FPreview.Margins.Top.AsPixels[ScreenPpi],
  2689.                          PagePixelsWidth  - FPreview.Margins.Right.AsPixels[ScreenPpi],
  2690.                          PagePixelsHeight - FPreview.Margins.Bottom.AsPixels[ScreenPpi])
  2691.   else
  2692.     Rgn := CreateRectRgn(0,
  2693.                          0,
  2694.                          PagePixelsWidth,
  2695.                          PagePixelsHeight);
  2696.     SelectClipRgn(ACanvas.Handle, Rgn);
  2697.  
  2698.   try
  2699.     for ICount := 0 to Self.Count-1 do
  2700.     begin
  2701.       TGmBaseObject(GmObject[ICount]).Page := Self.PageNum;
  2702.       TGmBaseObject(GmObject[ICount]).Draw(ACanvas, FPreview, Point(0,0), 1);
  2703.     end;
  2704.     //Dec(PagePixelsWidth, FPreview.Shadow.Width);
  2705.     //Dec(PagePixelsHeight, FPreview.Shadow.Width);
  2706.     if FPreview.Header.Visible then
  2707.       FPreview.Header.Draw(ACanvas, FPreview.Margins, Rect(0,0,PagePixelsWidth, PagePixelsHeight), FPageNum, 1);
  2708.  
  2709.     if FPreview.Footer.Visible then
  2710.       FPreview.Footer.Draw(ACanvas, FPreview.Margins, Rect(0,0,PagePixelsWidth, PagePixelsHeight), FPageNum, 1);
  2711.   finally
  2712.     ACanvas.Free;
  2713.   end;
  2714.   FPreview.MessageToControls(GM_PAGE_UPDATED, PageNum, 0);
  2715. end;
  2716.  
  2717. procedure TGmPage.LoadFromStream(AStream: TStream);
  2718.  
  2719.   function CreateGmObject(FObjectID: integer): TGmBaseObject;
  2720.   begin
  2721.     case FObjectID of
  2722.       GM_GRAPHIC_ID   : Result := TGmGraphicObject.Create;
  2723.       GM_LINE_ID      : Result := TGmLineObject.Create;
  2724.       GM_TEXT_ID      : Result := TGmTextObject.Create;
  2725.       GM_TEXTBOX_ID   : Result := TGmTextBoxObject.Create;
  2726.       GM_ELLIPSE_ID   : Result := TGmEllipseShape.Create;
  2727.       GM_RECTANGLE_ID : Result := TGmRectangleShape.Create;
  2728.       GM_ROUNDRECT_ID : Result := TGmRoundRectShape.Create;
  2729.       GM_ARC_ID       : Result := TGmArcShape.Create;
  2730.       GM_CHORD_ID     : Result := TGmChordShape.Create;
  2731.       GM_PIE_ID       : Result := TGmPieShape.Create;
  2732.       {$IFNDEF VER100}
  2733.       GM_POLYGON_ID   : Result := TGmPolygonObject.Create;
  2734.       GM_POLYLINE_ID  : Result := TGmPolyLineObject.Create;
  2735.       GM_POLYBEZIER_ID: Result := TGmPolyBezierObject.Create;
  2736.       {$ENDIF}
  2737.     else
  2738.       Result := nil;
  2739.     end;
  2740.   end;
  2741.  
  2742. var
  2743.   GmStream: TGmExtStream;
  2744.   NumObjects: integer;
  2745.   ICount: integer;
  2746.   AObjectID: integer;
  2747.   NewObject: TGmBaseObject;
  2748. begin
  2749.   GmStream := TGmExtStream.Create;
  2750.   try
  2751.     GmStream.LoadFromStream(AStream);
  2752.     FOrientation := TGmOrientation(GmStream.ReadInteger);
  2753.     NumObjects := GmStream.ReadInteger;
  2754.     for ICount := 1 to NumObjects do
  2755.     begin
  2756.       GmStream.ReadBuffer(AObjectID, SizeOf(AObjectID));
  2757.       NewObject := CreateGmObject(AObjectID);
  2758.       if Assigned(NewObject) then
  2759.       begin
  2760.         AddObject(NewObject);
  2761.         NewObject.LoadFromStream(GmStream);
  2762.       end;
  2763.     end;
  2764.   finally
  2765.     GmStream.Free;
  2766.   end;
  2767. end;
  2768.  
  2769. procedure TGmPage.SaveToStream(AStream: TStream);
  2770. var
  2771.   GmStream: TGmExtStream;
  2772.   ICount: integer;
  2773. begin
  2774.   GmStream := TGmExtStream.Create;
  2775.   try
  2776.     GmStream.WriteInteger(Ord(FOrientation));
  2777.     GmStream.WriteInteger(Self.Count);
  2778.     for ICount := 0 to Self.Count-1 do
  2779.     begin
  2780.       GmObject[ICount].SaveToStream(GmStream);
  2781.     end;
  2782.   finally
  2783.     GmStream.SaveToStream(AStream);
  2784.     GmStream.Free;
  2785.   end;
  2786. end;
  2787.  
  2788. //------------------------------------------------------------------------------
  2789.  
  2790. // *** TGmPageList ***
  2791.  
  2792. constructor TGmPageList.Create(AOwner: TGmPreview);
  2793. begin
  2794.   inherited Create;
  2795.   FPreview := AOwner;
  2796. end;
  2797.  
  2798. destructor TGmPageList.Destroy;
  2799. begin
  2800.   Clear;
  2801.   inherited Destroy;
  2802. end;
  2803.  
  2804. function TGmPageList.GetPage(APageIndex: integer): TGmPage;
  2805. begin
  2806.   Result := TGmPage(Self[APageIndex-1]);
  2807. end;
  2808.  
  2809. procedure TGmPageList.Repaginate;
  2810. var
  2811.   ICount: integer;
  2812. begin
  2813.   for ICount := 1 to Self.Count do
  2814.     Page[ICount].FPageNum := ICount;
  2815. end;
  2816.  
  2817. procedure TGmPageList.SetPage(APageIndex: integer; APage: TGmPage);
  2818. begin
  2819.   Self[APageIndex-1] := APage;
  2820. end;
  2821.  
  2822. function TGmPageList.AddPage: TGmPage;
  2823. var
  2824.   NewPage: TGmPage;
  2825. begin
  2826.   // add a page to the end of the list...
  2827.   NewPage := TGmPage.Create(FPreview);
  2828.   Self.Add(NewPage);
  2829.   Result := NewPage;
  2830.   //Result.Capacity := 1000;
  2831.   Result.FPageNum := Count;
  2832.   //Repaginate;
  2833. end;
  2834.  
  2835. procedure TGmPageList.Clear;
  2836. var
  2837.   ICount: integer;
  2838. begin
  2839.   // clear all pages from the list...
  2840.   for ICount := Self.Count-1 downto 0 do
  2841.     TGmPage(Self[ICount]).Free;
  2842.   inherited Clear;
  2843.   if Assigned(FPreview.OnClear) then FPreview.OnClear(FPreview);
  2844. end;
  2845.  
  2846. procedure TGmPageList.DeletePage(APage: integer);
  2847. begin
  2848.   TGmPage(Self[APage-1]).Free;
  2849.   Self.Delete(APage-1);
  2850.   Repaginate;
  2851.   if Assigned(FPreview.OnDeletePage) then FPreview.OnDeletePage(FPreview);
  2852. end;
  2853.  
  2854. //------------------------------------------------------------------------------
  2855.  
  2856. // *** TGmMargins ***
  2857.  
  2858. constructor TGmMargins.Create(AOwner: TGmPreview);
  2859. begin
  2860.   inherited Create;
  2861.   FPreview := AOwner;
  2862.   //FPaintBox := AOwner.FPageImage;
  2863.   // set up the pen objects...
  2864.   FPen := TPen.Create;
  2865.   FPen.Color := clSilver;
  2866.   FPen.Style := psDot;
  2867.   FPen.OnChange := PenChange;
  2868.   FPrinterPen := TPen.Create;
  2869.   FPrinterPen.Assign(FPen);
  2870.   FPrinterPen.OnChange := PenChange;
  2871.  
  2872.   FBottom := TGmValue.Create;
  2873.   FLeft := TGmValue.Create;
  2874.   FRight := TGmValue.Create;
  2875.   FTop := TGmValue.Create;
  2876.   // set the default values...
  2877.   FBottom.AsMillimeters := 25;
  2878.   FLeft.AsMillimeters := 15;
  2879.   FRight.AsMillimeters := 15;
  2880.   FTop.AsMillimeters := 20;
  2881.   FVisible := False;
  2882.   FShowPrintMargins := False;
  2883.   FClipMargins := False;
  2884.   FLeft.OnChange    := MarginsChanged;
  2885.   FTop.OnChange     := MarginsChanged;
  2886.   FRight.OnChange   := MarginsChanged;
  2887.   FBottom.OnChange  := MarginsChanged;
  2888. end;
  2889.  
  2890. destructor TGmMargins.Destroy;
  2891. begin
  2892.   FBottom.Free;
  2893.   FLeft.Free;
  2894.   FRight.Free;
  2895.   FTop.Free;
  2896.   FPen.Free;
  2897.   FPen := nil;
  2898.   FPrinterPen.Free;
  2899.   FPrinterPen := nil;
  2900.   inherited Destroy;
  2901. end;
  2902.  
  2903. function TGmMargins.AreMarginsValid: Boolean;
  2904. var
  2905.   APreview: TGmPreview;
  2906. begin
  2907.   APreview := TGmPreview(FPreview);
  2908.   Result := (FLeft.AsUnits   >= APreview.GmPrinter.PrinterMargins.Left.AsUnits) and
  2909.             (FTop.AsUnits    >= APreview.GmPrinter.PrinterMargins.Top.AsUnits) and
  2910.             (FRight.AsUnits  >= APreview.GmPrinter.PrinterMargins.Right.AsUnits) and
  2911.             (FBottom.AsUnits >= APreview.GmPrinter.PrinterMargins.Bottom.AsUnits);
  2912. end;
  2913.  
  2914. procedure TGmMargins.Assign(Source: TPersistent);
  2915. var
  2916.   AMargins: TGmMargins;
  2917. begin
  2918.   AMargins          := (Source as TGmMargins);
  2919.   FLeft.FValue      := AMargins.FLeft.FValue;
  2920.   FTop.FValue       := AMargins.FTop.FValue;
  2921.   FRight.FValue     := AMargins.FRight.FValue;
  2922.   FBottom.FValue    := AMargins.FBottom.FValue;
  2923.   FVisible          := AMargins.Visible;
  2924.   FShowPrintMargins := AMargins.FShowPrintMargins;
  2925.   FPen.Assign(AMargins.Pen);
  2926.   FPrinterPen.Assign(AMargins.PrinterMarginPen);
  2927.   if Assigned(FPaintBox) then FPaintBox.Invalidate;
  2928. end;
  2929.  
  2930. {procedure TGmMargins.LoadFromValues(AValues: TObject);
  2931. begin
  2932.   {with (AValues as TGmValueList) do
  2933.   begin
  2934.     Left.AsUnits   := ValueInt[C_MARGIN_LEFT];
  2935.     Top.AsUnits    := ValueInt[C_MARGIN_TOP];
  2936.     Right.AsUnits  := ValueInt[C_MARGIN_RIGHT];
  2937.     Bottom.AsUnits := ValueInt[C_MARGIN_BOTTOM];
  2938.     Visible        := Boolean(ValueInt[C_MARGIN_VISIBLE]);
  2939.     Pen.Color      := ValueInt[C_PEN_COLOR];
  2940.     Pen.Style      := TPenStyle(ValueInt[C_PEN_STYLE]);
  2941.     Pen.Width      := ValueInt[C_PEN_WIDTH];
  2942.     ShowPrinterMargins := False;
  2943.   end
  2944. end;}
  2945.  
  2946. procedure TGmMargins.LoadFromStream(AStream: TStream);
  2947. var
  2948.   GmStream: TGmExtStream;
  2949. begin
  2950.   GmStream := TGmExtStream.Create;
  2951.   try
  2952.     GmStream.LoadFromStream(AStream);
  2953.     FLeft.AsUnits       := GmStream.ReadInteger;
  2954.     FTop.AsUnits        := GmStream.ReadInteger;
  2955.     FRight.AsUnits      := GmStream.ReadInteger;
  2956.     FBottom.AsUnits     := GmStream.ReadInteger;
  2957.     FVisible            := GmStream.ReadBoolean;
  2958.     FShowPrintMargins   := GmStream.ReadBoolean;
  2959.     //GmPenToPen(FPen, GmStream.ReadPen);
  2960.     //GmPenToPen(FPrinterPen, GmStream.ReadPen);
  2961.     FClipMargins := GmStream.ReadBoolean;
  2962.   finally
  2963.     GmStream.Free;
  2964.   end;
  2965. end;
  2966.  
  2967.  
  2968. procedure TGmMargins.SaveToStream(AStream: TStream);
  2969. var
  2970.   GmStream: TGmExtStream;
  2971. begin
  2972.   GmStream := TGmExtStream.Create;
  2973.   try
  2974.     GmStream.WriteInteger(FLeft.AsUnits);
  2975.     GmStream.WriteInteger(FTop.AsUnits);
  2976.     GmStream.WriteInteger(FRight.AsUnits);
  2977.     GmStream.WriteInteger(FBottom.AsUnits);
  2978.     GmStream.WriteBoolean(FVisible);
  2979.     GmStream.WriteBoolean(FShowPrintMargins);
  2980.     //GmStream.WritePen(PenToGmPen(FPen));
  2981.     //GmStream.WritePen(PenToGmPen(FPrinterPen));
  2982.     GmStream.WriteBoolean(FClipMargins);
  2983.   finally
  2984.     GmStream.SaveToStream(AStream);
  2985.     GmStream.Free;
  2986.   end;
  2987. end;
  2988.  
  2989. procedure TGmMargins.UsePrinterMargins;
  2990. var
  2991.   APreview: TGmPreview;
  2992. begin
  2993.   APreview := TGmPreview(FPreview);
  2994.   FLeft.AsUnits   := APreview.GmPrinter.PrinterMargins.Left.AsUnits;
  2995.   FTop.AsUnits    := APreview.GmPrinter.PrinterMargins.Top.AsUnits;
  2996.   FRight.AsUnits  := APreview.GmPrinter.PrinterMargins.Right.AsUnits;
  2997.   FBottom.AsUnits := APreview.GmPrinter.PrinterMargins.Bottom.AsUnits;
  2998.   APreview.UpdatePreview;
  2999. end;
  3000.  
  3001. procedure TGmMargins.SetClipMargins(AValue: Boolean);
  3002. begin
  3003.   if FClipMargins <> AValue then
  3004.   begin
  3005.     FClipMargins := AValue;
  3006.     TGmPreview(FPreview).UpdatePreview;
  3007.   end;
  3008. end;
  3009.  
  3010. procedure TGmMargins.PenChange(Sender: TObject);
  3011. begin
  3012.   if Assigned(FPaintBox) then FPaintBox.Invalidate;
  3013. end;
  3014.  
  3015. procedure TGmMargins.SetShowPrinterMargins(AValue: Boolean);
  3016. begin
  3017.   FShowPrintMargins := AValue;
  3018.   if Assigned(FPaintBox) then FPaintBox.Invalidate;
  3019. end;
  3020.  
  3021. procedure TGmMargins.SetVisible(AValue: Boolean);
  3022. begin
  3023.   FVisible := AValue;
  3024.   if Assigned(FPaintBox) then
  3025.     FPaintBox.Invalidate;
  3026. end;
  3027.  
  3028. procedure TGmMargins.MarginsChanged(AObject: TObject);
  3029. begin
  3030.   if Assigned(FPreview) then
  3031.   begin
  3032.     FPreview.MessageToControls(GM_USER_MARGINS_CHANGED, 0, 0);
  3033.     if Assigned(FPreview.FOnChangeMargins) then FPreview.OnChangeMargins(Self);
  3034.   end;
  3035. end;
  3036.  
  3037.  
  3038. //------------------------------------------------------------------------------
  3039.  
  3040. constructor TGmPageImage.Create(AOwner: TComponent);
  3041. begin
  3042.   inherited Create(AOwner);
  3043.   FValue1 := TGmValue.Create;
  3044.   FValue2 := TGmValue.Create;
  3045.   Screen.Cursors[crZoomIn]  := LoadCursor(HInstance, 'ZoomIn');
  3046.   Screen.Cursors[crZoomOut] := LoadCursor(HInstance, 'ZoomOut');
  3047.   FWidthInches := 8.2;
  3048.   FHeightInches := 11.6;
  3049.   Gutter := 30;
  3050. end;
  3051.  
  3052. destructor TGmPageImage.Destroy;
  3053. begin
  3054.   FValue1.Free;
  3055.   FValue2.Free;
  3056.   inherited Destroy;
  3057. end;
  3058.  
  3059. procedure TGmPageImage.CMMouseLeave (var Message: TMessage);
  3060. begin
  3061.   (Owner as TGmPreview).StopPanning;
  3062. end;
  3063.  
  3064. procedure TGmPageImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3065. var
  3066.   APreview: TGmPreview;
  3067. begin
  3068.   inherited;
  3069.   if (X > Gutter) and (Y > Gutter) and
  3070.      (X < (Width - Gutter)) and (Y < (Height-Gutter)) then
  3071.   begin
  3072.     APreview := (Owner as TGmPreview);
  3073.  
  3074.     APreview.MouseDown(Button, Shift, Left+X, Top+Y);
  3075.  
  3076.     if Assigned(APreview.OnPageMouseDown) then
  3077.     begin
  3078.       FValue1.AsPixels[ScreenPpi] := Round((X-Gutter) / Scale);
  3079.       FValue2.AsPixels[ScreenPpi] := Round((Y-Gutter) / Scale);
  3080.       APreview.OnPageMouseDown(APreview, Button, Shift, FValue1, FValue2);
  3081.     end;
  3082.   end;
  3083. end;
  3084.  
  3085. procedure TGmPageImage.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3086. var
  3087.   APreview: TGmPreview;
  3088. begin
  3089.   inherited;
  3090.   if (X > Gutter) and (Y > Gutter) and
  3091.      (X < (Width - Gutter)) and (Y < (Height-Gutter)) then
  3092.   begin
  3093.     APreview := (Owner as TGmPreview);
  3094.     APreview.MouseUp(Button, Shift, Left+X, Top+Y);
  3095.     if Assigned(APreview.OnPageMouseUp) then
  3096.     begin
  3097.       FValue1.AsPixels[ScreenPpi] := Round((X-Gutter) / Scale);
  3098.       FValue2.AsPixels[ScreenPpi] := Round((Y-Gutter) / Scale);
  3099.       APreview.OnPageMouseUp(APreview, Button, Shift, FValue1, FValue2);
  3100.     end;
  3101.   end;
  3102. end;
  3103.  
  3104. procedure TGmPageImage.MouseMove(Shift: TShiftState; X, Y: Integer);
  3105. var
  3106.   APreview: TGmPreview;
  3107. begin
  3108.   inherited;
  3109.   if (X > Gutter) and (Y > Gutter) and
  3110.      (X < (Width - Gutter)) and (Y < (Height-Gutter)) then
  3111.   begin
  3112.     APreview := (Owner as TGmPreview);
  3113.     APreview.MouseMove(Shift, Left+X, Top+Y);
  3114.     if Assigned(APreview.OnPageMouseMove) then
  3115.     begin
  3116.       FValue1.AsPixels[ScreenPpi] := Round((X-Gutter) / Scale);
  3117.       FValue2.AsPixels[ScreenPpi] := Round((Y-Gutter) / Scale);
  3118.       APreview.OnPageMouseMove(APreview, Shift, FValue1, FValue2);
  3119.     end;
  3120.   end;
  3121. end;
  3122.  
  3123. procedure TGmPageImage.Paint;
  3124. var
  3125.   Margins: TGmMargins;
  3126.   Ppi: integer;
  3127.   APreview: TGmPreview;
  3128.   ShadowWidth: integer;
  3129. begin
  3130.   inherited;
  3131.   if Assigned(FMargins) then
  3132.   begin
  3133.     Margins := TGmMargins(FMargins);
  3134.     APreview := TGmPreview(Owner);
  3135.     ShadowWidth := APreview.Shadow.Width;
  3136.     if Margins.Visible then
  3137.     begin
  3138.       // paint the margins...
  3139.       with Canvas do
  3140.       begin
  3141.         Ppi := Screen.PixelsPerInch;
  3142.         Brush.Style := bsClear;
  3143.         Pen.Assign(Margins.Pen);
  3144.         Rectangle(Gutter+(Round(Margins.Left.AsPixels[Ppi]*Scale)),
  3145.                   Gutter+(Round(Margins.Top.AsPixels[Ppi]*Scale)),
  3146.                   (Width-(Round(Margins.Right.AsPixels[Ppi]*Scale))-(Gutter))-ShadowWidth,
  3147.                   (Height-(Round(Margins.Bottom.AsPixels[Ppi]*Scale))-(Gutter))-ShadowWidth);
  3148.       end;
  3149.     end;
  3150.     if Margins.ShowPrinterMargins then
  3151.     begin
  3152.       // paint the margins...
  3153.       with Canvas do
  3154.       begin
  3155.         Brush.Style := bsClear;
  3156.         Ppi := Screen.PixelsPerInch;
  3157.         Brush.Style := bsClear;
  3158.         Pen.Assign(Margins.Pen);
  3159.         Rectangle(Gutter+ (Round(APreview.GmPrinter.PrinterMargins.Left.AsPixels[Ppi]*Scale)),
  3160.                   Gutter+ (Round(APreview.GmPrinter.PrinterMargins.Top.AsPixels[Ppi]*Scale)),
  3161.                   Width-  (Round(APreview.GmPrinter.PrinterMargins.Right.AsPixels[Ppi]*Scale))-(Gutter)-ShadowWidth,
  3162.                   Height- (Round(APreview.GmPrinter.PrinterMargins.Bottom.AsPixels[Ppi]*Scale))-(Gutter)-ShadowWidth);
  3163.       end;
  3164.     end;
  3165.   end;
  3166. end;
  3167.  
  3168. procedure TGmPageImage.SetHeightInches(AValue: Extended);
  3169. begin
  3170.   FHeightInches := AValue;
  3171.   RecalculateSize;
  3172. end;
  3173.  
  3174. procedure TGmPageImage.SetWidthInches(AValue: Extended);
  3175. begin
  3176.   FWidthInches := AValue;
  3177.   RecalculateSize;
  3178. end;
  3179.  
  3180. procedure TGmPageImage.RecalculateSize;
  3181. var
  3182.   Ppi: integer;
  3183. begin
  3184.   Ppi := Screen.PixelsPerInch;
  3185.   FPageWidth   := Round(FScale*(FWidthInches * Ppi));
  3186.   FPageHeight  := Round(FScale*(FHeightInches * Ppi));
  3187.   Width  := FPageWidth   + Gutter*2;
  3188.   Height := FPageHeight + Gutter*2;
  3189. end;
  3190.  
  3191. procedure TGmPageImage.SetScale(AScale: Extended);
  3192. begin
  3193.   FScale := AScale;
  3194.   RecalculateSize;
  3195. end;
  3196.  
  3197.  
  3198.  
  3199. //------------------------------------------------------------------------------
  3200.  
  3201. // *** TGmHeaderFooterCaption ***
  3202.  
  3203. constructor TGmHeaderFooterCaption.Create(AOwner: TGmHeaderFooter);
  3204. begin
  3205.   inherited Create;
  3206.   FHeaderFooter := AOwner;
  3207.   FFont := TFont.Create;
  3208.   FFont.Size := 12;
  3209.   FFont.Name := 'Arial';
  3210.   FCaption := '';
  3211.   Font.OnChange := FontChange;
  3212. end;
  3213.  
  3214. destructor TGmHeaderFooterCaption.Destroy;
  3215. begin
  3216.   FFont.Free;
  3217.   inherited Destroy;
  3218. end;
  3219.  
  3220. procedure TGmHeaderFooterCaption.Assign(Source: TPersistent);
  3221. begin
  3222.   // ???
  3223. end;
  3224.  
  3225. procedure TGmHeaderFooterCaption.LoadFromStream(AStream: TStream);
  3226. var
  3227.   GmStream: TGmExtStream;
  3228. begin
  3229.   GmStream := TGmExtStream.Create;
  3230.   try
  3231.     GmStream.LoadFromStream(AStream);
  3232.     GmFontToFont(FFont, GmStream.ReadFont, 1);
  3233.     FCaption := GmStream.ReadStr;
  3234.   finally
  3235.     GmStream.Free;
  3236.   end;
  3237. end;
  3238.  
  3239. procedure TGmHeaderFooterCaption.SaveToStream(AStream: TStream);
  3240. var
  3241.   GmStream: TGmExtStream;
  3242. begin
  3243.   GmStream := TGmExtStream.Create;
  3244.   try
  3245.     //GmStream.LoadFromStream(AStream);
  3246.     GmStream.WriteFont(FontToGmFont(FFont));
  3247.     GmStream.WriteStr(FCaption);
  3248.     //GmFontToFont(FFont, GmStream.ReadFont);
  3249.     //FCaption := GmStream.ReadStr;
  3250.   finally
  3251.     GmStream.SaveToStream(AStream);
  3252.     GmStream.Free;
  3253.   end;
  3254. end;
  3255.  
  3256. procedure TGmHeaderFooterCaption.FontChange(Sender: TObject);
  3257. begin
  3258.   FHeaderFooter.RequestUpdate;
  3259. end;
  3260.  
  3261. procedure TGmHeaderFooterCaption.SetCaption(ACaption: string);
  3262. begin
  3263.   FCaption := ACaption;
  3264.   FHeaderFooter.RequestUpdate;
  3265. end;
  3266.  
  3267. procedure TGmHeaderFooterCaption.SetFont(AFont: TFont);
  3268. begin
  3269.   FFont.Assign(AFont);
  3270.   FHeaderFooter.RequestUpdate;
  3271. end;
  3272.  
  3273. //------------------------------------------------------------------------------
  3274.  
  3275. // *** TGmHeaderFooter ***
  3276.  
  3277. constructor TGmHeaderFooter.Create(AOwner: TGmPreview);
  3278. begin
  3279.   inherited Create;
  3280.   FState := hfCreating;
  3281.   FPreview := AOwner;
  3282.   FCanvas := FPreview.Canvas;
  3283.   FCaptionLeft    := TGmHeaderFooterCaption.Create(Self);
  3284.   FCaptionCenter  := TGmHeaderFooterCaption.Create(Self);
  3285.   FCaptionRight   := TGmHeaderFooterCaption.Create(Self);
  3286.   FPen := TPen.Create;
  3287.   Pen.OnChange := PenChange;
  3288.   FHeight := TGmValue.Create;
  3289.   FShowLine := True;
  3290.   FVisible := True;
  3291.   FState := hfIdle;
  3292. end;
  3293.  
  3294. destructor TGmHeaderFooter.Destroy;
  3295. begin
  3296.   FState := hfDestroying;
  3297.   FCaptionLeft.Free;
  3298.   FCaptionCenter.Free;
  3299.   FCaptionRight.Free;
  3300.   FPen.Free;
  3301.   FPen.OnChange := PenChange;
  3302.   FHeight.Free;
  3303.   FState := hfIdle;
  3304.   inherited Destroy;
  3305. end;
  3306.  
  3307. procedure TGmHeaderFooter.Assign(Source: TPersistent);
  3308. begin
  3309.  // ???
  3310. end;
  3311.  
  3312. procedure TGmHeaderFooter.LoadFromStream(AStream: TStream);
  3313. var
  3314.   GmStream: TGmExtStream;
  3315. begin
  3316.   GmStream := TGmExtStream.Create;
  3317.   try
  3318.     GmStream.LoadFromStream(AStream);
  3319.     FShowLine := GmStream.ReadBoolean;
  3320.     FVisible  := GmStream.ReadBoolean;
  3321.     FCaptionLeft.LoadFromStream(GmStream);
  3322.     FCaptionCenter.LoadFromStream(GmStream);
  3323.     FCaptionRight.LoadFromStream(GmStream);
  3324.     GmPenToPen(FPen, GmStream.ReadPen);
  3325.   finally
  3326.     GmStream.Free;
  3327.   end;
  3328. end;
  3329.  
  3330. procedure TGmHeaderFooter.SaveToStream(AStream: TStream);
  3331. var
  3332.   GmStream: TGmExtStream;
  3333. begin
  3334.   GmStream := TGmExtStream.Create;
  3335.   try
  3336.     GmStream.WriteBoolean(FShowLine);
  3337.     GmStream.WriteBoolean(FVisible);
  3338.     FCaptionLeft.SaveToStream(GmStream);
  3339.     FCaptionCenter.SaveToStream(GmStream);
  3340.     FCaptionRight.SaveToStream(GmStream);
  3341.     GmStream.WritePen(PenToGmPen(FPen));
  3342.   finally
  3343.     GmStream.SaveToStream(AStream);
  3344.     GmStream.Free;
  3345.   end;
  3346. end;
  3347.  
  3348.  
  3349. procedure TGmHeaderFooter.SetCaptionLeft(ACaption: string);
  3350. begin
  3351.   FCaptionLeft.Caption := ACaption;
  3352. end;
  3353.  
  3354. procedure TGmHeaderFooter.SetCaptionCenter(ACaption: string);
  3355. begin
  3356.   FCaptionCenter.Caption := ACaption;
  3357. end;
  3358.  
  3359. procedure TGmHeaderFooter.SetCaptionRight(ACaption: string);
  3360. begin
  3361.   FCaptionRight.Caption := ACaption;
  3362. end;
  3363.  
  3364. procedure TGmHeaderFooter.SetCaptionLeftFont(AFont: TFont);
  3365. begin
  3366.   FCaptionLeft.Font.Assign(AFont);
  3367. end;
  3368.  
  3369. procedure TGmHeaderFooter.SetCaptionCenterFont(AFont: TFont);
  3370. begin
  3371.   FCaptionCenter.Font.Assign(AFont);
  3372. end;
  3373.  
  3374. procedure TGmHeaderFooter.SetCaptionRightFont(AFont: TFont);
  3375. begin
  3376.   FCaptionRight.Font.Assign(AFont);
  3377. end;
  3378.  
  3379. function TGmHeaderFooter.GetCaptionLeft: string;
  3380. begin
  3381.   Result := FCaptionLeft.Caption;
  3382. end;
  3383.  
  3384. function TGmHeaderFooter.GetCaptionCenter: string;
  3385. begin
  3386.   Result := FCaptionCenter.Caption;
  3387. end;
  3388.  
  3389. function TGmHeaderFooter.GetCaptionRight: string;
  3390. begin
  3391.   Result := FCaptionRight.Caption;
  3392. end;
  3393.  
  3394. function TGmHeaderFooter.GetCaptionLeftFont: TFont;
  3395. begin
  3396.   Result := FCaptionLeft.Font;
  3397. end;
  3398.  
  3399. function TGmHeaderFooter.GetCaptionCenterFont: TFont;
  3400. begin
  3401.   Result := FCaptionCenter.Font;
  3402. end;
  3403.  
  3404. function TGmHeaderFooter.GetCaptionRightFont: TFont;
  3405. begin
  3406.   Result := FCaptionRight.Font;
  3407. end;
  3408.  
  3409. procedure TGmHeaderFooter.PenChange(Sender: TObject);
  3410. begin
  3411.   RequestUpdate;
  3412. end;
  3413.  
  3414. procedure TGmHeaderFooter.RequestUpdate;
  3415. begin
  3416.   if FState = hfIdle then FPreview.MessageToControls(GM_UPDATE_PREVIEW, 0, 0);
  3417. end;
  3418.  
  3419. procedure TGmHeaderFooter.SetPen(APen: TPen);
  3420. begin
  3421.   FPen.Assign(APen);
  3422.   RequestUpdate;
  3423. end;
  3424.  
  3425. procedure TGmHeaderFooter.SetShowLine(AValue: Boolean);
  3426. begin
  3427.   FShowLine := AValue;
  3428.   RequestUpdate;
  3429. end;
  3430.  
  3431. procedure TGmHeaderFooter.SetVisible(AVisible: Boolean);
  3432. begin
  3433.   FVisible := AVisible;
  3434.   RequestUpdate;
  3435. end;
  3436.  
  3437. function TGmHeaderFooter.GetCaptionHeight(ACanvas: TCanvas; ACaption: string): integer;
  3438. var
  3439.   {$IFNDEF VER100}
  3440.   Metrics: tagTEXTMETRIC;
  3441.   {$ELSE}
  3442.   Metrics: TTextMetricA;
  3443.   {$ENDIF}
  3444. begin
  3445.   ACanvas.Lock;
  3446.   with ACanvas do
  3447.   try
  3448.     GetTextMetrics(ACanvas.Handle, Metrics);
  3449.   finally
  3450.     Unlock;
  3451.   end;
  3452.   Result := Metrics.tmHeight;
  3453. end;
  3454.  
  3455. function TGmHeaderFooter.GetHeight: TGmValue;
  3456. begin
  3457.   Result := FHeight;
  3458.   if FVisible then
  3459.   begin
  3460.     FCanvas.FTempCanvas.Font := GetLargestFont;
  3461.     Result.AsPixels[ScreenPpi] := GetCaptionHeight(FCanvas.FTempCanvas, ' ') + 2;
  3462.   end
  3463.   else
  3464.     Result.AsUnits := 0;
  3465. end;
  3466.  
  3467. function TGmHeaderFooter.GetLargestFont: TFont;
  3468. begin
  3469.   Result := FCaptionLeft.Font;
  3470.   if (FCaptionCenter.Font.Size > Result.Size) then Result := FCaptionCenter.Font;
  3471.   if (FCaptionRight.Font.Size  > Result.Size) then Result := FCaptionRight.Font;
  3472. end;
  3473.  
  3474. //------------------------------------------------------------------------------
  3475.  
  3476. // *** TGmHeader ***
  3477.  
  3478. procedure TGmHeader.Draw(ACanvas: TCanvas; Margins: TGmMargins; PageRect: TRect;
  3479.   APageNum: integer; Scale: Extended);
  3480. var
  3481.   MarginRect: TRect;
  3482.   CenterPoint: integer;
  3483.   TextWidth: integer;
  3484.   TextHeight: integer;
  3485.   LastStyle: TBrushStyle;
  3486.   Tokenized: string;
  3487.   CanvasPpi: integer;
  3488.   Offset: TPoint;
  3489. begin
  3490.   Offset.x := 0;
  3491.   Offset.y := 0;
  3492.  
  3493.   FState := hfDrawing;
  3494.  
  3495.   LastStyle := ACanvas.Brush.Style;
  3496.   ACanvas.Brush.Style := bsClear;
  3497.  
  3498.   CanvasPpi := PixelsPerInchX(ACanvas.Handle);
  3499.   ACanvas.Font := (GetLargestFont);
  3500.   MarginRect.Left   := PageRect.Left  + ((0-Offset.X) + Round(Scale * Margins.Left.AsPixels[CanvasPpi]));
  3501.   MarginRect.Top    := PageRect.Top   + ((0-Offset.Y) + Round(Scale * Margins.Top.AsPixels[CanvasPpi]));
  3502.   MarginRect.Right  := PageRect.Right - ((0-Offset.X) + Round(Scale * Margins.Right.AsPixels[CanvasPpi]));
  3503.   MarginRect.Bottom := MarginRect.Top + ((0-Offset.Y) + Round(Scale * Height.AsPixels[CanvasPpi]));
  3504.  
  3505.   // left caption...
  3506.   ACanvas.Font.Assign(FCaptionLeft.Font);
  3507.   ACanvas.Font.PixelsPerInch := Round(CanvasPpi / Scale);
  3508.   Tokenized := FPreview.Tokenize(FCaptionLeft.Caption, APageNum);
  3509.   TextHeight := GetCaptionHeight(ACanvas, Tokenized);
  3510.   ACanvas.TextOut(MarginRect.Left, (MarginRect.Bottom-TextHeight), Tokenized);
  3511.  
  3512.   // center caption...
  3513.   CenterPoint := (MarginRect.Right + MarginRect.Left) div 2;
  3514.   ACanvas.Font.Assign(FCaptionCenter.Font);
  3515.   ACanvas.Font.PixelsPerInch := Round(CanvasPpi / Scale);
  3516.   Tokenized := FPreview.Tokenize(FCaptionCenter.Caption, APageNum);
  3517.   TextHeight := GetCaptionHeight(ACanvas, Tokenized);
  3518.   TextWidth := ACanvas.TextWidth(Tokenized);
  3519.   ACanvas.TextOut(CenterPoint-(TextWidth div 2), (MarginRect.Bottom-TextHeight), Tokenized);
  3520.  
  3521.   // right caption...
  3522.   ACanvas.Font.Assign(FCaptionRight.Font);
  3523.   ACanvas.Font.PixelsPerInch := Round(CanvasPpi / Scale);
  3524.   Tokenized := FPreview.Tokenize(FCaptionRight.Caption, APageNum);
  3525.   TextHeight  := GetCaptionHeight(ACanvas, Tokenized);
  3526.   TextWidth   := ACanvas.TextWidth(Tokenized);
  3527.   ACanvas.TextOut(MarginRect.Right-TextWidth, (MarginRect.Bottom-TextHeight), Tokenized);
  3528.  
  3529.   if FShowLine then
  3530.   begin
  3531.     ACanvas.Pen.Assign(FPen);
  3532.     ACanvas.MoveTo(MarginRect.Left, MarginRect.Bottom);
  3533.     ACanvas.LineTo(MarginRect.Right, MarginRect.Bottom);
  3534.   end;
  3535.   ACanvas.Brush.Style := LastStyle;
  3536.   FState := hfIdle;
  3537. end;
  3538.  
  3539. //------------------------------------------------------------------------------
  3540.  
  3541. // *** TGmFooter ***
  3542.  
  3543. procedure TGmFooter.Draw(ACanvas: TCanvas; Margins: TGmMargins; PageRect: TRect;
  3544.   APageNum: integer; Scale: Extended);
  3545. var
  3546.   MarginRect: TRect;
  3547.   CenterPoint: integer;
  3548.   TextWidth: integer;
  3549.   LastStyle: TBrushStyle;
  3550.   Tokenized: string;
  3551.   CanvasPpi: integer;
  3552.   Offset: TPoint;
  3553. begin
  3554.   Offset.x := 0;
  3555.   Offset.y := 0;
  3556.  
  3557.   FState := hfDrawing;
  3558.   LastStyle := ACanvas.Brush.Style;
  3559.   ACanvas.Brush.Style := bsClear;
  3560.   CanvasPpi := PixelsPerInchX(ACanvas.Handle);
  3561.   ACanvas.Font := (GetLargestFont);
  3562.   MarginRect.Left   := PageRect.Left    + ((0-Offset.X) + Round(Scale * Margins.Left.AsPixels[CanvasPpi]));
  3563.   MarginRect.Top    := PageRect.Bottom  - Round(Scale * (Height.AsPixels[CanvasPpi]+Margins.Bottom.AsPixels[CanvasPpi]));
  3564.   MarginRect.Right  := PageRect.Right   - ((0-Offset.X) +  Round(Scale * Margins.Right.AsPixels[CanvasPpi]));
  3565.   MarginRect.Bottom := PageRect.Bottom  - Round(Scale * (Margins.Bottom.AsPixels[CanvasPpi]));
  3566.  
  3567.   // left caption...
  3568.   ACanvas.Font.Assign(FCaptionLeft.Font);
  3569.   ACanvas.Font.PixelsPerInch := Round(CanvasPpi / Scale);
  3570.   Tokenized := FPreview.Tokenize(FCaptionLeft.Caption, APageNum);
  3571.   ACanvas.TextOut(MarginRect.Left, (MarginRect.Top), Tokenized);
  3572.  
  3573.   // center caption...
  3574.   CenterPoint := (MarginRect.Right + MarginRect.Left) div 2;
  3575.   ACanvas.Font.Assign(FCaptionCenter.Font);
  3576.   ACanvas.Font.PixelsPerInch := Round(CanvasPpi / Scale);
  3577.   Tokenized := FPreview.Tokenize(FCaptionCenter.Caption, APageNum);
  3578.   TextWidth := ACanvas.TextWidth(Tokenized);
  3579.   ACanvas.TextOut(CenterPoint-(TextWidth div 2), (MarginRect.Top), Tokenized);
  3580.  
  3581.   // right caption...
  3582.   ACanvas.Font.Assign(FCaptionRight.Font);
  3583.   ACanvas.Font.PixelsPerInch := Round(CanvasPpi / Scale);
  3584.   Tokenized := FPreview.Tokenize(FCaptionRight.Caption, APageNum);
  3585.   TextWidth := ACanvas.TextWidth(Tokenized);
  3586.   ACanvas.TextOut(MarginRect.Right-TextWidth, (MarginRect.Top), Tokenized);
  3587.  
  3588.   if FShowLine then
  3589.   begin
  3590.     ACanvas.Pen.Assign(FPen);
  3591.     ACanvas.MoveTo(MarginRect.Left, MarginRect.Top);
  3592.     ACanvas.LineTo(MarginRect.Right, MarginRect.Top);
  3593.   end;
  3594.   ACanvas.Brush.Style := LastStyle;
  3595.   FState := hfIdle;
  3596. end;
  3597.  
  3598. //------------------------------------------------------------------------------
  3599.  
  3600. constructor TGmOptions.Create;
  3601. begin
  3602.   inherited Create;
  3603.   FZoomIn := LeftButton;
  3604.   FZoomOut := RightButton;
  3605. end;
  3606.  
  3607. procedure TGmOptions.SetZoomIn(AUserAction: TGmUserAction);
  3608. begin
  3609.   if FZoomIn <> AUserAction then
  3610.   begin
  3611.     FZoomIn := AUserAction;
  3612.   end;
  3613. end;
  3614.  
  3615. procedure TGmOptions.SetZoomOut(AUserAction: TGmUserAction);
  3616. begin
  3617.   if FZoomOut <> AUserAction then
  3618.   begin
  3619.     FZoomOut := AUserAction;
  3620.   end;
  3621. end;
  3622.  
  3623. //------------------------------------------------------------------------------
  3624.  
  3625. // *** TGmPreview ***
  3626.  
  3627. constructor TGmPreview.Create(AOwner: TComponent);
  3628. begin
  3629.   FPreviewState := gmCreating;
  3630.   inherited Create(AOwner);
  3631.   FMessagesEnabled := False;
  3632.   FZoom := DEFAULT_ZOOM;
  3633.   FPaperSize := A4;
  3634.   FBorderStyle := bsSingle;
  3635.   FPages := TGmPageList.Create(Self);
  3636.   FCurrentPage := 1;
  3637.   FCanvas := TGmCanvas.Create(Self);
  3638.   FCanvas.Page := FPages.AddPage;
  3639.   FFooter := TGmFooter.Create(Self);
  3640.   FHeader := TGmHeader.Create(Self);
  3641.   FMargins := TGmMargins.Create(Self);
  3642.   FOptions := TGmOptions.Create;
  3643.   FPageImage := TGmPageImage.Create(Self);
  3644.   FMargins.FPaintBox := FPageImage;
  3645.   FPageImage.Margins := FMargins;
  3646.   FPageImage.Parent := Self;
  3647.   FPageImage.OnMouseMove := Self.OnMouseMove;
  3648.   FPrintBorder := TGmValue.Create;
  3649.   FPrintCopies := 1;
  3650.   FPageHeight := TGmValue.Create;
  3651.   FPageWidth := TGmValue.Create;
  3652.   FPageHeight.AsMillimeters := 297;
  3653.   FPageWidth.AsMillimeters := 210;
  3654.   FPrinter := TGmPrinter.Create(Self);
  3655.   FRegisteredComponents := TList.Create;
  3656.   FZoomIncrement := 10;
  3657.   Ctl3D := True;
  3658.   Width := 220;
  3659.   Height := 286;
  3660.   {$IFNDEF VER100}
  3661.   HorzScrollBar.Size := 16;
  3662.   VertScrollBar.Size := 16;
  3663.   {$ENDIF}
  3664.   FMaxZoom := 400;
  3665.   FMinZoom := 10;
  3666.   FMessagesEnabled := True;
  3667.   FPreviewState := gmIdle;
  3668.   FPageImage.Scale := FZoom / 100;
  3669. end;
  3670.  
  3671. procedure TGmPreview.CreateParams(var Params: TCreateParams);
  3672. const
  3673.   BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
  3674. begin
  3675.   inherited CreateParams(Params);
  3676.   with Params do
  3677.   begin
  3678.     Style := Style or BorderStyles[FBorderStyle];
  3679.     if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  3680.     begin
  3681.       Style := Style and not WS_BORDER;
  3682.       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  3683.     end;
  3684.   end;
  3685. end;
  3686.  
  3687. destructor TGmPreview.Destroy;
  3688. begin
  3689.   FPreviewState := gmDestroying;
  3690.   FCanvas.Free;
  3691.   FFooter.Free;
  3692.   FHeader.Free;
  3693.   FMargins.Free;
  3694.   FOptions.Free;
  3695.   FPages.Free;
  3696.   FPrinter.Free;
  3697.   FPrintBorder.Free;
  3698.   FPageHeight.Free;
  3699.   FPageWidth.Free;
  3700.   FRegisteredComponents.Free;
  3701.   FPreviewState := gmIdle;
  3702.   inherited Destroy;
  3703. end;
  3704.  
  3705. procedure TGmPreview.Loaded;
  3706. begin
  3707.   inherited Loaded;
  3708.   if Assigned(FOnPageChange) then FOnPageChange(Self, FCurrentPage);
  3709. end;
  3710.  
  3711. procedure TGmPreview.MessageToControls(AMessage: integer; Param1, Param2: integer);
  3712. var
  3713.   ICount: integer;
  3714. begin
  3715.   if FMessagesEnabled then
  3716.   begin
  3717.     SendMessage(Self.Handle, AMessage, Param1, Param2);
  3718.     for ICount := 0 to FRegisteredComponents.Count-1 do
  3719.       TControl(FRegisteredComponents[ICount]).Perform(AMessage, Param1, Param2);
  3720.   end;
  3721. end;
  3722.  
  3723. procedure TGmPreview.CMMouseLeave (var Message: TMessage);
  3724. begin
  3725.   StopPanning;
  3726. end;
  3727.  
  3728. procedure TGmPreview.MouseMove(Shift: TShiftState; X, Y: Integer);
  3729. var
  3730.   VertSBSize: integer;
  3731.   HorzSBSize: integer;
  3732. begin
  3733.   FMousePos.X := X;
  3734.   FMousePos.Y := Y;
  3735.   if FPanning then
  3736.   begin
  3737.     HorzScrollBar.Position := FPanningXYStart.X - FMousePos.X;
  3738.     VertScrollBar.Position := FPanningXYStart.Y - FMousePos.Y;
  3739.   end;
  3740.  
  3741.   {$IFNDEF VER100}
  3742.   VertSBSize := VertScrollBar.Size;
  3743.   HorzSBSize := HorzScrollBar.Size;
  3744.   {$ELSE}
  3745.   VertSBSize := 18;
  3746.   HorzSBSize := 18;
  3747.   {$ENDIF}
  3748.   if X > (Width-4)  - VertSBSize then
  3749.     StopPanning;
  3750.   if Y > (Height-4) - HorzSBSize then
  3751.     StopPanning;
  3752.   inherited;
  3753. end;
  3754.  
  3755. procedure TGmPreview.SetParent(AParent: TWinControl);
  3756. begin
  3757.   inherited SetParent(AParent);
  3758.   if Assigned(AParent) then UpdatePreview;
  3759. end;
  3760.  
  3761. procedure TGmPreview.PositionPage;
  3762. var
  3763.   ScrollBarX: Extended;
  3764.   ScrollBarY: Extended;
  3765.   RangeX,
  3766.   RangeY: integer;
  3767. begin
  3768.   // Get the current scrollbar values...
  3769.   RangeX := (HorzScrollBar.Range-Width);
  3770.   RangeY := (VertScrollBar.Range-Height);
  3771.  
  3772.   ScrollBarX := 0;
  3773.   ScrollBarY := 0;
  3774.   if RangeX > 0 then ScrollBarX := HorzScrollBar.Position / RangeX;
  3775.   if RangeY > 0 then ScrollBarY := VertScrollBar.Position / RangeY;
  3776.  
  3777.  
  3778.   if FPageImage.Width > Width then
  3779.   begin
  3780.     HorzScrollBar.Visible := True;
  3781.     HorzScrollBar.Position := Round((HorzScrollBar.Range - Width)*ScrollBarX);
  3782.   end
  3783.   else
  3784.   begin
  3785.     HorzScrollBar.Position := 0;
  3786.     HorzScrollBar.Visible := False;
  3787.     FPageImage.Left := 0;
  3788.   end;
  3789.   if FPageImage.Height > Height then
  3790.   begin
  3791.     VertScrollBar.Visible := True;
  3792.     VertScrollBar.Position := Round((VertScrollBar.Range - Height)*ScrollBarY);
  3793.   end
  3794.   else
  3795.   begin
  3796.     VertScrollBar.Position := 0;
  3797.     VertScrollBar.Visible := False;
  3798.     FPageImage.Top := 0;
  3799.   end;
  3800.   CenterPage;
  3801. end;
  3802.  
  3803. procedure TGmPreview.PreviewResize(var Message: TMessage);
  3804. begin
  3805.   inherited;
  3806.   CenterPage;
  3807. end;
  3808.  
  3809. procedure TGmPreview.UpdateMessage(var Message: TMessage);
  3810. begin
  3811.   UpdatePreview;
  3812. end;
  3813.  
  3814. procedure TGmPreview.MarginsChanged(var Message: TMessage);
  3815. begin
  3816.   UpdatePreview;
  3817. end;
  3818.  
  3819. {procedure TGmPreview.RegisterComponent(var Message: TMessage);
  3820. begin
  3821.   FRegisteredComponents.Add(IntToStr(Message.WParam));
  3822. end;}
  3823.  
  3824. procedure TGmPreview.AddAssociatedComponent(AComponent: TComponent);
  3825. begin
  3826.   if FRegisteredComponents.IndexOf(AComponent) = -1 then
  3827.     FRegisteredComponents.Add(AComponent);
  3828. end;
  3829.  
  3830. procedure TGmPreview.RemoveAssociatedComponent(AComponent: TComponent);
  3831. begin
  3832.   if FRegisteredComponents.IndexOf(AComponent) <> -1 then
  3833.     FRegisteredComponents.Delete(FRegisteredComponents.IndexOf(AComponent));
  3834. end;
  3835.  
  3836. {procedure TGmPreview.UnRegisterComponent(var Message: TMessage);
  3837. begin
  3838.   with FRegisteredComponents do
  3839.     Delete(IndexOf(IntToStr(Message.WParam)));
  3840. end;}
  3841.  
  3842. function TGmPreview.GetFileVersion(AFileName: string): Extended;
  3843. var
  3844.   //AStream: TGmExtStream;
  3845.   AStream: TFileStream;
  3846. begin
  3847.   Result := -1;
  3848.   AStream := TFileStream.Create(AFileName, fmOpenRead);
  3849.   try
  3850.     try
  3851.       AStream.Read(Result, SizeOf(Result));
  3852.     except
  3853.       ShowGmError(Self, CANT_READ_VERSION);
  3854.     end;
  3855.   finally
  3856.     AStream.Free;
  3857.   end;
  3858.  
  3859.   {AStream := TGmExtStream.Create;
  3860.   try
  3861.     try
  3862.       AStream.LoadFromFile(AFileName);
  3863.       try
  3864.         Result := AStream.ReadExtended;
  3865.       except
  3866.         ShowGmError(Self, CANT_READ_VERSION);
  3867.       end;
  3868.     except
  3869.       ShowGmError(Self, CANT_OPEN_FILE);
  3870.     end;
  3871.   finally
  3872.     AStream.Free;
  3873.   end;  }
  3874.  
  3875. end;
  3876.  
  3877. function TGmPreview.Tokenize(AText: string; APage: integer): string;
  3878. var
  3879.   tokenPosition: integer;
  3880. begin
  3881.  
  3882.   Result := AText;
  3883.   // search and replace the {DATE} token...
  3884.   while Pos('{DATE}', Result) <> 0 do
  3885.   begin
  3886.     tokenPosition := Pos('{DATE}', Result);
  3887.     Delete(Result, tokenPosition, 6);
  3888.     Insert(FormatDateTime('dd-mmm-yyyy',Date), Result, tokenPosition);
  3889.   end;
  3890.  
  3891.   // search and replace the {TIME} token...
  3892.   while Pos('{TIME}', Result) <> 0 do
  3893.   begin
  3894.     tokenPosition := Pos('{TIME}', Result);
  3895.     Delete(Result, tokenPosition, 6);
  3896.     Insert(FormatDateTime('hh:nn',Time), Result, tokenPosition);
  3897.   end;
  3898.  
  3899.   // search and replace the {PAGE} token...
  3900.   while Pos('{PAGE}', Result) <> 0 do
  3901.   begin
  3902.     tokenPosition := Pos('{PAGE}', Result);
  3903.     Delete(Result, tokenPosition, 6);
  3904.     Insert(IntToStr(APage), Result, tokenPosition);
  3905.   end;
  3906.  
  3907.   // search and replace the {NUMPAGES} token...
  3908.   while Pos('{NUMPAGES}', Result) <> 0 do
  3909.   begin
  3910.     tokenPosition := Pos('{NUMPAGES}', Result);
  3911.     Delete(Result, tokenPosition, 10);
  3912.     Insert(IntToStr(NumPages), Result, tokenPosition);
  3913.   end;
  3914. end;
  3915.  
  3916. procedure TGmPreview.CenterOnClick(x, y: integer);
  3917. var
  3918.   CenterPoint: TPoint;
  3919. begin
  3920.   CenterPoint.X := Width div 2;
  3921.   CenterPoint.Y := Height div 2;
  3922.   HorzScrollBar.Position := HorzScrollBar.Position + (x - CenterPoint.X);
  3923.   VertScrollBar.Position := VertScrollBar.Position + (y - CenterPoint.y);
  3924. end;
  3925.  
  3926. procedure TGmPreview.Clear;
  3927. var
  3928.   ICount: integer;
  3929.   PageChanged: Boolean;
  3930.   ATempValue: Boolean;
  3931. begin
  3932.   //if FP
  3933.   PageChanged := FCurrentPage > 1;
  3934.   ATempValue := FMessagesEnabled;
  3935.   FMessagesEnabled := False;
  3936.   for ICount := NumPages downto 1 do
  3937.     DeletePage(ICount);
  3938.   //Application.ProcessMessages;
  3939.   FMessagesEnabled := ATempValue;
  3940.   MessageToControls(GM_PREVIEW_CLEARED, 0, 0);
  3941.   if PageChanged then MessageToControls(GM_PAGE_CHANGED, 1, 0);
  3942.   FPageImage.Invalidate;
  3943. end;
  3944.  
  3945. procedure TGmPreview.DeleteCurrentPage;
  3946. begin
  3947.   DeletePage(FCurrentPage);
  3948. end;
  3949.  
  3950. procedure TGmPreview.DeletePage(APage: integer);
  3951. begin
  3952.   if NumPages > 1 then
  3953.     FPages.DeletePage(APage) else
  3954.   if NumPages = 1 then
  3955.     FPages.Page[APage].Clear;
  3956.   if FCurrentPage > NumPages then
  3957.     SetCurrentPage(NumPages)
  3958.   else
  3959.     SetCurrentPage(FCurrentPage);
  3960.   MessageToControls(GM_NUMPAGES_CHANGED, FPages.Count, 0);
  3961.   MessageToControls(GM_UPDATE_PREVIEW, FPages.Count, 0);
  3962. end;
  3963.  
  3964. procedure TGmPreview.FirstPage;
  3965. begin
  3966.   CurrentPage := 1;
  3967. end;
  3968.  
  3969. procedure TGmPreview.FitHeight;
  3970. begin
  3971.   SetZoom(GetFitHeightZoom);
  3972. end;
  3973.  
  3974. procedure TGmPreview.FitWidth;
  3975. begin
  3976.   SetZoom(GetFitWidthZoom);
  3977. end;
  3978.  
  3979. procedure TGmPreview.FitWholePage;
  3980. begin
  3981.   SetZoom(MinInt(GetFitHeightZoom, GetFitWidthZoom));
  3982. end;
  3983.  
  3984. procedure TGmPreview.LastPage;
  3985. begin
  3986.   CurrentPage := NumPages;
  3987. end;
  3988.  
  3989. function TGmPreview.NewPage: TGmPage;
  3990. begin
  3991.   //UpdatePreview;
  3992.   //FCanvas.FPage.DrawPage;
  3993.   //FCanvas.FPage.DrawPage(InchWidth, InchHeight);
  3994.   FCanvas.FPage := FPages.AddPage;
  3995.   MessageToControls(GM_NUMPAGES_CHANGED, FPages.Count, 0);
  3996.   CurrentPage := FPages.Count;
  3997.   Result := FCanvas.Page;
  3998.   if Assigned(FOnNewPage) then FOnNewPage(Self);
  3999. end;
  4000.  
  4001. procedure TGmPreview.NextPage;
  4002. begin
  4003.   if CurrentPage < NumPages then
  4004.     CurrentPage := CurrentPage + 1;
  4005. end;
  4006.  
  4007. procedure TGmPreview.PrevPage;
  4008. begin
  4009.   if CurrentPage > 1 then
  4010.     CurrentPage := CurrentPage - 1;
  4011. end;
  4012.  
  4013. procedure TGmPreview.Print;
  4014. begin
  4015.   PrintRange(1, NumPages);
  4016. end;
  4017.  
  4018. procedure TGmPreview.PrintRange(AStartPage, AEndPage: integer);
  4019.  
  4020. function GetPageRect(Pps: TGmPagesPerSheet; PrnRect: TRect; PageNum: integer): TRect;
  4021.   begin
  4022.     case PagesPerSheet of
  4023.       gmOnePage:
  4024.       begin
  4025.         Result := PrnRect;
  4026.       end;
  4027.       gmTwoPage:
  4028.       begin
  4029.         if FOrientation = gmPortrait then
  4030.         begin
  4031.           case PageNum mod 2 of
  4032.             1:  Result := Rect(PrnRect.Left, PrnRect.Top, PrnRect.Right div 2, PrnRect.Bottom);
  4033.             0:  Result := Rect(PrnRect.Right div 2, PrnRect.Top, PrnRect.Right, PrnRect.Bottom);
  4034.           end;
  4035.         end
  4036.         else
  4037.         begin
  4038.           case PageNum mod 2 of
  4039.             1:  Result := Rect(PrnRect.Left, PrnRect.Top, PrnRect.Right, PrnRect.Bottom div 2);
  4040.             0:  Result := Rect(PrnRect.Left, PrnRect.Bottom div 2, PrnRect.Right, PrnRect.Bottom);
  4041.           end;
  4042.         end;
  4043.       end;
  4044.       gmFourPage:
  4045.       begin
  4046.         case PageNum mod 4 of
  4047.           1:  Result := Rect(PrnRect.Left, PrnRect.Top, PrnRect.Right div 2, PrnRect.Bottom div 2);
  4048.           2:  Result := Rect(PrnRect.Right div 2, PrnRect.Top, PrnRect.Right, PrnRect.Bottom div 2);
  4049.           3:  Result := Rect(PrnRect.Left, PrnRect.Bottom div 2, PrnRect.Right div 2, PrnRect.Bottom);
  4050.           0:  Result := Rect(PrnRect.Right div 2, PrnRect.Bottom div 2, PrnRect.Right, PrnRect.Bottom);
  4051.         end;
  4052.       end;
  4053.     end;
  4054.   end;
  4055.  
  4056.   function CheckForNewPage(Pps: TGmPagesPerSheet; PageNum, NumPages: integer): boolean;
  4057.   begin
  4058.     Result := PageNum < NumPages;
  4059.     case Pps of
  4060.       gmTwoPage : Result := (PageNum mod 2 = 0) and (PageNum < NumPages);
  4061.       gmFourPage: Result := (PageNum mod 4 = 0) and (PageNum < NumPages);
  4062.     end;
  4063.   end;
  4064.  
  4065.   function SwapOrientation: Boolean;
  4066.   begin
  4067.     case Printer.Orientation of
  4068.       poPortrait  : Printer.Orientation := poLandscape;
  4069.       poLandscape : Printer.Orientation := poPortrait;
  4070.     end;
  4071.     Result := True;
  4072.   end;
  4073.  
  4074.   procedure SwapValues(var Val1, Val2: integer);
  4075.   var
  4076.     TempVal: integer;
  4077.   begin
  4078.     TempVal := Val1;
  4079.     Val1 := Val2;
  4080.     Val2 := TempVal;
  4081.   end;
  4082.  
  4083. var
  4084.   IPageCount: integer;
  4085.   IPrintedCount: integer;
  4086.   ICopyCount: integer;
  4087.   IObjectCount: integer;
  4088.   APage: TGmPage;
  4089.   PageRect,
  4090.   PrinterRect: TRect;
  4091.  
  4092.   AScale: Extended;
  4093.   PW, PH: integer;
  4094.   Offset: TPoint;
  4095.   OrientationChanged: Boolean;
  4096. begin
  4097.   if Assigned(FBeforePrint) then FBeforePrint(Self);
  4098.  
  4099.   // Multiple orientation reports only support 1 Page-per-sheet printing...
  4100.   if GetOrientationType = gmMixedOrientation then FPagesPerSheet := gmOnePage;
  4101.  
  4102.   OrientationChanged := False;
  4103.   Offset.x := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
  4104.   Offset.y := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
  4105.  
  4106.   PW := GetDeviceCaps(Printer.Handle, PHYSICALWIDTH);
  4107.   PH := GetDeviceCaps(Printer.Handle, PHYSICALHEIGHT);
  4108.  
  4109.   AScale := 1;
  4110.  
  4111.   PrinterRect.Left := 0;
  4112.   PrinterRect.Top :=  0;
  4113.  
  4114.   IPrintedCount := 0;
  4115.  
  4116.   case PagesPerSheet of
  4117.     gmOnePage, gmFourPage :
  4118.     begin
  4119.       if ((FOrientation = gmLandscape) and (Printer.Orientation = poPortrait)) or
  4120.          ((FOrientation = gmPortrait) and (Printer.Orientation = poLandscape)) then
  4121.       begin
  4122.         OrientationChanged := SwapOrientation;
  4123.         SwapValues(PW, PH);
  4124.       end;
  4125.       // set the page scale for 4 pages per sheet...
  4126.       if PagesPerSheet = gmFourPage then AScale := 0.5;
  4127.     end;
  4128.     gmTwoPage :
  4129.     begin
  4130.       if ((FOrientation = gmLandscape) and (Printer.Orientation <> poPortrait)) or
  4131.          ((FOrientation = gmPortrait) and (Printer.Orientation <> poLandscape)) then
  4132.       begin
  4133.         OrientationChanged := SwapOrientation;
  4134.         SwapValues(PW, PH);
  4135.       end;
  4136.       // set the page scale for 4 pages per sheet...
  4137.       AScale := MinInt(PW, PH) / MaxInt(PW, PH);
  4138.     end;
  4139.   end;
  4140.  
  4141.   PrinterRect.Right  := PW;
  4142.   PrinterRect.Bottom := PH;
  4143.  
  4144.   GmPrinter.BeginDoc(FPrintFile);
  4145.   for ICopyCount := 1 to FPrintCopies do
  4146.   try
  4147.     for IPageCount := AStartPage to AEndPage do
  4148.     begin
  4149.       APage := Pages[IPageCount];
  4150.  
  4151.       if Assigned(FBeforePrintPage) then
  4152.         FBeforePrintPage(Self, APage, Printer.Handle);
  4153.  
  4154.       PageRect := GetPageRect(PagesPerSheet, PrinterRect, IPageCount);
  4155.  
  4156.       PageRect.Left   := PageRect.Left    - FPrinter.GetOffset.X;
  4157.       PageRect.Top    := PageRect.Top     - FPrinter.GetOffset.Y;
  4158.       PageRect.Right  := PageRect.Right   - FPrinter.GetOffset.X;
  4159.       PageRect.Bottom := PageRect.Bottom  - FPrinter.GetOffset.Y;
  4160.  
  4161.       if Header.Visible then
  4162.         Header.Draw(GmPrinter.Canvas, FMargins, PageRect, IPageCount, AScale);
  4163.       if Footer.Visible then
  4164.         Footer.Draw(GmPrinter.Canvas, FMargins, PageRect, IPageCount, AScale);
  4165.  
  4166.       for IObjectCount := 0 to FPages.Page[IPageCount].Count-1 do
  4167.       begin
  4168.         TGmBaseObject(APage.GmObject[IObjectCount]).Draw(GmPrinter.Canvas, Self, Point(0-PageRect.Left, 0-PageRect.Top), AScale);
  4169.       end;
  4170.       if CheckForNewPage(PagesPerSheet, IPageCount, AEndPage) then
  4171.       begin
  4172.         GmPrinter.NewPage(Pages[IPageCount+1].Orientation);
  4173.         if Pages[IPageCount].Orientation <> Pages[IPageCount+1].Orientation then
  4174.         begin
  4175.           SwapValues(PrinterRect.Right, PrinterRect.Bottom);
  4176.         end;
  4177.       end;
  4178.       Inc(IPrintedCount);
  4179.       if Assigned(FOnPrintProgress) then FOnPrintProgress(Self, IPrintedCount, 1+(AEndPage-AStartPage));
  4180.     end
  4181.   finally
  4182.     GmPrinter.EndDoc;
  4183.     FPrintFile := '';
  4184.     //if PagesPerSheet = gmTwoPage then SwapOrientation;
  4185.     if OrientationChanged then SwapOrientation;
  4186.     if Assigned(FAfterPrint) then FAfterPrint(Self);
  4187.   end;
  4188. end;
  4189.  
  4190. procedure TGmPreview.PrintCurrentPage;
  4191. begin
  4192.   PrintRange(FCurrentPage, FCurrentPage);
  4193. end;
  4194.  
  4195. procedure TGmPreview.PrintToFile(AFileName: string);
  4196. begin
  4197.   FPrintFile := AFileName;
  4198.   PrintRange(FCurrentPage, FCurrentPage);
  4199. end;
  4200.  
  4201.  
  4202. //------------------------------------------------------------------------------
  4203.  
  4204. // File/Stream Saving/Loading routines...
  4205.  
  4206. procedure TGmPreview.LoadFromFile(AFilename: string);
  4207. var
  4208.   AFileStream: TFileStream;
  4209.   AFileVersion: Extended;
  4210. begin
  4211.   AFileStream := TFileStream.Create(AFileName, fmOpenRead);
  4212.   try
  4213.     AFileStream.Read(AFileVersion, SizeOf(AFileVersion));
  4214.     if AFileVersion < 2.3 then
  4215.       // use the old load method...
  4216.       LoadFromStreamOld(Self, AFileStream)
  4217.     else
  4218.     begin
  4219.       // the current method...
  4220.       AFileStream.Seek(0, soFromBeginning);
  4221.       LoadFromStream(AFileStream);
  4222.     end;
  4223.   finally
  4224.     AFileStream.Free;
  4225.   end;
  4226. end;
  4227.  
  4228. procedure TGmPreview.SaveToFile(AFilename: string);
  4229. var
  4230.   AFileStream: TFileStream;
  4231. begin
  4232.   AFileStream := TFileStream.Create(AFileName, fmCreate);
  4233.   try
  4234.     SaveToStream(AFileStream);
  4235.   finally
  4236.     AFileStream.Free;
  4237.   end;
  4238. end;
  4239.  
  4240. procedure TGmPreview.LoadFromStream(AStream: TStream);
  4241. var
  4242.   AFileVersion: Extended;
  4243.   GmStream: TGmExtStream;
  4244.   ICount: integer;
  4245.   APage: TGmPage;
  4246.   LoadFile: Boolean;
  4247. begin
  4248.   MessageToControls(GM_LOADING, 0, 0);
  4249.   AStream.ReadBuffer(AFileVersion, SizeOf(AFileVersion));
  4250.   GmStream := TGmExtStream.Create;
  4251.   try
  4252.     Clear;
  4253.     if Assigned(FBeforeReadStream) then FBeforeReadStream(Self, GmStream);
  4254.     GmStream.LoadFromStream(AStream);
  4255.     //AFileVersion := GmStream.ReadExtended;
  4256.     LoadFile := True;
  4257.     if Assigned(FBeforeLoad) then FBeforeLoad(Self, AFileVersion, LoadFile);
  4258.     if LoadFile = False then Exit;
  4259.     LoadDocInfoFromStream(GmStream);
  4260.     LoadPageSetupFromStream(GmStream);
  4261.     Margins.LoadFromStream(GmStream);
  4262.     FHeader.LoadFromStream(GmStream);
  4263.     Footer.LoadFromStream(GmStream);
  4264.     for ICount := 1 to FNumPages do
  4265.     begin
  4266.       if ICount = 1 then APage := FPages.Page[1] else APage := NewPage;
  4267.       APage.LoadFromStream(GmStream);
  4268.       if Assigned(FOnLoadProgress) then FOnLoadProgress(Self, Round(ICount/FNumPages*100));
  4269.     end;
  4270.   finally
  4271.     GmStream.Free;
  4272.   end;
  4273.   MessageToControls(GM_LOADING, 1, 0);
  4274.   MessageToControls(GM_UPDATE_PREVIEW, 0, 0);
  4275. end;
  4276.  
  4277. procedure TGmPreview.SaveToStream(AStream: TStream);
  4278. var
  4279.   GmStream: TGmExtStream;
  4280.   ICount: integer;
  4281.   AVersion: Extended;
  4282. begin
  4283.   AVersion := SUITE_VERSION;
  4284.   AStream.WriteBuffer(AVersion, SizeOf(AVersion));
  4285.   GmStream := TGmExtStream.Create;
  4286.   try
  4287.     //GmStream.WriteExtended(SUITE_VERSION);
  4288.     SaveDocInfoToStream(GmStream);
  4289.     SavePageSetupToStream(GmStream);
  4290.     Margins.SaveToStream(GmStream);
  4291.  
  4292.     FHeader.SaveToStream(GmStream);
  4293.     FFooter.SaveToStream(GmStream);
  4294.     for ICount := 1 to NumPages do
  4295.     begin
  4296.       FPages.Page[ICount].SaveToStream(GmStream);
  4297.       if Assigned(FOnSaveProgress) then FOnSaveProgress(Self, Round(ICount/FNumPages*100));
  4298.     end; 
  4299.   finally
  4300.     if Assigned(FBeforeWriteStream) then FBeforeWriteStream(Self, GmStream);
  4301.     GmStream.SaveToStream(AStream);
  4302.     GmStream.Free;
  4303.   end;
  4304. end;
  4305.  
  4306. procedure TGmPreview.LoadPageSetupFromStream(AStream: TStream);
  4307. var
  4308.   GmStream: TGmExtStream;
  4309. begin
  4310.   GmStream := TGmExtStream.Create;
  4311.   try
  4312.     GmStream.LoadFromStream(AStream);
  4313.     FPageWidth.AsUnits  := GmStream.ReadInteger;
  4314.     FPageHeight.AsUnits := GmStream.ReadInteger;
  4315.     FPaperSize := StrToPaperSize(GmStream.ReadStr);
  4316.     FOrientation := TGmOrientation(GmStream.ReadInteger);
  4317.     Shadow.Color := GmStream.ReadInteger;
  4318.     Shadow.Width := GmStream.ReadInteger;
  4319.     MessageToControls(GM_PAPER_SIZE_CHANGED, 0, 0);
  4320.     MessageToControls(GM_ORIENTATION_CHANGED, 0, 0);
  4321.   finally
  4322.     GmStream.Free;
  4323.   end;
  4324. end;
  4325.  
  4326. procedure TGmPreview.SavePageSetupToStream(AStream: TStream);
  4327. var
  4328.   GmStream: TGmExtStream;
  4329. begin
  4330.   GmStream := TGmExtStream.Create;
  4331.   try
  4332.     GmStream.WriteInteger(FPageWidth.AsUnits);
  4333.     GmStream.WriteInteger(FPageHeight.AsUnits);
  4334.     GmStream.WriteStr(PaperSizeToStr(FPaperSize));
  4335.     GmStream.WriteInteger(Ord(Orientation));
  4336.     GmStream.WriteInteger(Shadow.Color);
  4337.     GmStream.WriteInteger(Shadow.Width);
  4338.   finally
  4339.     GmStream.SaveToStream(AStream);
  4340.     GmStream.Free;
  4341.   end;
  4342. end;
  4343.  
  4344. procedure TGmPreview.LoadDocInfoFromStream(AStream: TStream);
  4345. var
  4346.   GmStream: TGmExtStream;
  4347. begin
  4348.   GmStream := TGmExtStream.Create;
  4349.   try
  4350.     GmStream.LoadFromStream(AStream);
  4351.     GmStream.ReadDateTime;
  4352.     FNumPages := GmStream.ReadInteger;
  4353.   finally
  4354.     GmStream.Free;
  4355.   end;
  4356. end;
  4357.  
  4358. procedure TGmPreview.SaveDocInfoToStream(AStream: TStream);
  4359. var
  4360.   GmStream: TGmExtStream;
  4361. begin
  4362.   GmStream := TGmExtStream.Create;
  4363.   try
  4364.     // the two following values aren't used yet... but I thought they may be
  4365.     // needed at a later time.
  4366.     GmStream.WriteDateTime(Now);
  4367.     GmStream.WriteInteger(NumPages);
  4368.   finally
  4369.     GmStream.SaveToStream(AStream);
  4370.     GmStream.Free;
  4371.   end;
  4372. end;
  4373.  
  4374. // End of File/Stream Saving/Loading routines
  4375.  
  4376. //------------------------------------------------------------------------------
  4377.  
  4378. procedure TGmPreview.ScrollToPosition(XPercent, YPercent: Extended);
  4379. begin
  4380.   HorzScrollBar.Position := Round((XPercent/100) * (HorzScrollBar.Range-(ClientWidth)));
  4381.   VertScrollBar.Position := Round((YPercent/100) * (VertScrollBar.Range-(ClientHeight)));
  4382.   //if XPercent <> -1 then HorzScrollBar.Position := Round((HorzScrollBar.Range / 100) * XPercent);
  4383.  // if YPercent <> -1 then VertScrollBar.Position := Round((VertScrollBar.Range / 100) * YPercent);
  4384. end;
  4385.  
  4386.  
  4387. procedure TGmPreview.SetCursor(ACursor: TGmCursor);
  4388. begin
  4389.   case ACursor of
  4390.     gmDefault   : Screen.Cursor := crDefault;
  4391.     gmZoomIn    : Screen.Cursor := crZoomIn;
  4392.     gmZoomOut   : Screen.Cursor := crZoomOut;
  4393.   end;
  4394. end;
  4395.  
  4396. procedure TGmPreview.SetPageSize(AWidth, AHeight: Extended; AUnits: TGmMeasurement);
  4397. begin
  4398.   FPaperSize := Custom;
  4399.   FPageWidth.AsUnits := Round(ConvertValue(AWidth, AUnits, GmUnits));
  4400.   FPageHeight.AsUnits := Round(ConvertValue(AHeight, AUnits, GmUnits));
  4401.   if Assigned(FOnPageSizeChange) then FOnPageSizeChange(Self);
  4402. end;
  4403.  
  4404. procedure TGmPreview.StartPanning;
  4405. begin
  4406.   FPanning := True;
  4407.   FPanningXYStart.X := FMousePos.X + HorzScrollBar.Position;
  4408.   FPanningXYStart.Y := FMousePos.Y + VertScrollBar.Position;
  4409.   Screen.Cursor := crHandPoint;
  4410. end;
  4411.  
  4412. procedure TGmPreview.StopPanning;
  4413. begin
  4414.   FPanning := False;
  4415.   Screen.Cursor := crDefault;
  4416. end;
  4417.  
  4418. procedure TGmPreview.UpdatePreview;
  4419. var
  4420.   AWidth, AHeight: Integer;
  4421.   InchWidth, InchHeight: Extended;
  4422.   APage: TGmPage;
  4423. begin
  4424.   if FPaperSize <> Custom then
  4425.     GetPaperSize(FPaperSize, AWidth, AHeight, Canvas.Page.Orientation)
  4426.   else
  4427.   begin
  4428.     // if it is a custom page size... work out the dimensions...
  4429.     if Canvas.Page.Orientation = gmPortrait then
  4430.     begin
  4431.       AWidth  := MinInt(FPageWidth.AsUnits, FPageHeight.AsUnits);
  4432.       AHeight := MaxInt(FPageWidth.AsUnits, FPageHeight.AsUnits);
  4433.     end
  4434.     else
  4435.     begin
  4436.       AWidth  := MaxInt(FPageWidth.AsUnits, FPageHeight.AsUnits);
  4437.       AHeight := MinInt(FPageWidth.AsUnits, FPageHeight.AsUnits);
  4438.     end;
  4439.   end;
  4440.  
  4441.   InchWidth   := ConvertValue(AWidth, GmUnits, GmInches);
  4442.   InchHeight  := ConvertValue(AHeight, GmUnits, GmInches);
  4443.  
  4444.   FPageImage.WidthInches  := InchWidth;
  4445.   FPageImage.HeightInches := InchHeight;
  4446.  
  4447.   APage := FPages.Page[FCurrentPage];
  4448.   APage.FInchWidth  := InchWidth;
  4449.   APage.FInchHeight := InchHeight;
  4450.   APage.DrawPage;//(InchWidth, InchHeight);
  4451.   FCanvas.Page := APage;
  4452.  
  4453.   FPageImage.SetPageMetafile(APage.Metafile, FMessagesEnabled);
  4454.  
  4455.   MessageToControls(GM_PREVIEW_UPDATED, NumPages, 0);
  4456.   //SendMessage(Self.Handle, WM_SIZE, 0, 0);
  4457.   //MessageToControls(WM_SIZE, 0, 0);
  4458.   Application.ProcessMessages;
  4459. end;
  4460.  
  4461. procedure TGmPreview.UsePrinterPageSize;
  4462. begin
  4463.   if FPrinter.PrinterSelected then
  4464.   begin
  4465.     SetPageSize(FPrinter.PrinterWidth.AsUnits, FPrinter.PrinterHeight.AsUnits, GmUnits);
  4466.     MessageToControls(GM_UPDATE_PREVIEW, 0, 0);
  4467.   end;
  4468. end;
  4469.  
  4470. procedure TGmPreview.ZoomIn;
  4471. begin
  4472.   case FZoomStyle of
  4473.     gmFixedZoom   : SetZoom(FZoom + FZoomIncrement);
  4474.     gmVariableZoom: SetZoom(FZoom + (FZoom div 2));
  4475.   end;
  4476. end;
  4477.  
  4478. procedure TGmPreview.ZoomOut;
  4479. begin
  4480.   case FZoomStyle of
  4481.     gmFixedZoom   : SetZoom(FZoom - FZoomIncrement);
  4482.     gmVariableZoom: SetZoom(FZoom - (FZoom div 2));
  4483.   end;
  4484. end;
  4485.  
  4486. function TGmPreview.GetPage(APage: integer): TGmPage;
  4487. begin
  4488.   Result := FPages.Page[APage];
  4489. end;
  4490.  
  4491. function TGmPreview.GetPrinterBinIndex: integer;
  4492. begin
  4493.   Result := FPrinter.PrinterBinIndex;
  4494. end;
  4495.  
  4496. function TGmPreview.GetPrinterBins: TStrings;
  4497. begin
  4498.   Result := FPrinter.PrinterBins;
  4499. end;
  4500.  
  4501. function TGmPreview.GetPrinterIndex: integer;
  4502. begin
  4503.   Result := FPrinter.PrinterIndex;
  4504. end;
  4505.  
  4506. function TGmPreview.GetPrinters: TStrings;
  4507. begin
  4508.   Result := FPrinter.FPrinterNames;
  4509. end;
  4510.  
  4511. function TGmPreview.GetShadow: TGmShadow;
  4512. begin
  4513.   Result := FPageImage.Shadow;
  4514. end;
  4515.  
  4516. function TGmPreview.GetPrintTitle: string;
  4517. begin
  4518.   Result := FPrinter.Title;
  4519. end;
  4520.  
  4521. function TGmPreview.GetVersion: Extended;
  4522. begin
  4523.   Result := SUITE_VERSION;
  4524. end;
  4525.  
  4526. function TGmPreview.PaperSizeToStr(APaperSize: TGmPaperSize): string;
  4527. begin
  4528.   case APaperSize of
  4529.     A4    : Result := 'A4';
  4530.     A5    : Result := 'A5';
  4531.   else
  4532.     Result := 'Custom';
  4533.   end;
  4534. end;
  4535.  
  4536. function TGmPreview.StrToPaperSize(APaperStr: string): TGmPaperSize;
  4537. begin
  4538.   if APaperStr = 'A4' then Result := A4 else
  4539.   if APaperStr = 'A5' then Result := A5 else
  4540.   Result := Custom;
  4541. end;
  4542.  
  4543. function TGmPreview.GetCoordsRelative: TGmCoordsRelative;
  4544. begin
  4545.   Result := FCanvas.CoordsRelativeTo;
  4546. end;
  4547.  
  4548. function TGmPreview.GetFitHeightZoom: integer;
  4549. var
  4550.   AScale: Extended;
  4551. begin
  4552.   AScale := (Height-2*FPageImage.Gutter) / (FPageImage.HeightInches*ScreenPpi);
  4553.   Result := Trunc(AScale * 100);
  4554. end;
  4555.  
  4556. function TGmPreview.GetFitWidthZoom: integer;
  4557. var
  4558.   AScale: Extended;
  4559. begin
  4560.   AScale := (Width-(2*FPageImage.Gutter)) / (FPageImage.WidthInches*ScreenPpi);
  4561.   Result := Trunc(AScale * 100);
  4562. end;
  4563.  
  4564. function TGmPreview.GetMetaFile(APage: integer): TMetafile;
  4565. begin
  4566.   Result := FPages.Page[APage].Metafile;
  4567. end;
  4568.  
  4569. function TGmPreview.GetNumPages: integer;
  4570. begin
  4571.   Result := FPages.Count;
  4572. end;
  4573.  
  4574. function TGmPreview.GetOrientationType: TGmOrientationType;
  4575. var
  4576.   ICount: integer;
  4577. begin
  4578.   if FOrientation = GmPortrait then
  4579.     Result := gmPortraitReport
  4580.   else
  4581.     Result := gmLandscapeReport;
  4582.   for ICount := 1 to GetNumPages do
  4583.     if Pages[ICount].Orientation <> FOrientation then Result := gmMixedOrientation;
  4584. end;
  4585.  
  4586.  
  4587. procedure TGmPreview.CenterPage;
  4588. begin
  4589.   if FPageImage.Height < Height then FPageImage.Top := (Height - FPageImage.Height-8) div 2;
  4590.   if FPageImage.Width < Width   then FPageImage.Left := (Width - FPageImage.Width-8) div 2;
  4591.   if (FPageImage.Height > Height) and (FPageImage.Top > 0) then FPageImage.Top := 0;
  4592.   if (FPageImage.Width > Width) and (FPageImage.Left > 0) then FPageImage.Left := 0;
  4593. end;
  4594.  
  4595. procedure TGmPreview.SetBorderStyle(AStyle: TBorderStyle);
  4596. begin
  4597.   if FBorderStyle <> AStyle then
  4598.   begin
  4599.     FBorderStyle := AStyle;
  4600.     RecreateWnd;
  4601.   end;
  4602. end;
  4603.  
  4604. procedure TGmPreview.SetCoordsRelative(ACoordsRelative: TGmCoordsRelative);
  4605. begin
  4606.   FCanvas.CoordsRelativeTo := ACoordsRelative;
  4607. end;
  4608.  
  4609. procedure TGmPreview.SetCurrentPage(APage: integer);
  4610. //var
  4611.   //LastPage: integer;
  4612. begin
  4613.   if (APage <> FCurrentPage) then
  4614.   begin
  4615.     //LastPage := APage;
  4616.     FCurrentPage := APage;
  4617.     Canvas.Page := Pages[APage];
  4618.     if Assigned(FOnPageChange) then FOnPageChange(Self, APage);
  4619.     UpdatePreview;
  4620.     MessageToControls(GM_PAGE_CHANGED, APage, 0);
  4621.   end;
  4622. end;
  4623.  
  4624. procedure TGmPreview.SetGutter(AGutter: integer);
  4625. begin
  4626.   if AGutter <> FGutter then
  4627.   begin
  4628.     FGutter := AGutter;
  4629.     FPageImage.Gutter := FGutter;
  4630.   end;
  4631. end;
  4632.  
  4633. procedure TGmPreview.SetOrientation(AOrientation: TGmOrientation);
  4634. var
  4635.   ICount: integer;
  4636.   TempValue: integer;
  4637.   TempBoolean: Boolean;
  4638. begin
  4639.   if FOrientation <> AOrientation then
  4640.   begin
  4641.     TempValue := PageHeight.AsUnits;
  4642.     PageHeight.AsUnits := PageWidth.AsUnits;
  4643.     PageWidth.AsUnits := TempValue;
  4644.     FOrientation := AOrientation;
  4645.     if Assigned(FOnChangeOrientation) then FOnChangeOrientation(Self);
  4646.     TempBoolean := FMessagesEnabled;
  4647.     FMessagesEnabled := False;
  4648.     for ICount := 1 to NumPages do FPages.Page[ICount].Orientation := AOrientation;
  4649.     UpdatePreview;
  4650.     PositionPage;
  4651.     FMessagesEnabled := TempBoolean;
  4652.     MessageToControls(GM_ORIENTATION_CHANGED, 0, 0);
  4653.   end;
  4654. end;
  4655.  
  4656. procedure TGmPreview.SetPagesPerSheet(APagesPerSheet: TGmPagesPerSheet);
  4657. begin
  4658.   FPagesPerSheet := APagesPerSheet;
  4659.   MessageToControls(GM_MULTIPAGE_CHANGED, 0, 0);
  4660. end;
  4661.  
  4662. procedure TGmPreview.SetPaperSize(APaperSize: TGmPaperSize);
  4663. var
  4664.   w, h: integer;
  4665. begin
  4666.   FPaperSize := APaperSize;
  4667.   if APaperSize <> Custom then
  4668.   begin
  4669.     GetPaperSize(FPaperSize, w, h, FOrientation);
  4670.     MessagesEnabled := False;
  4671.     FPageWidth.AsUnits := w;
  4672.     FPageHeight.AsUnits := h;
  4673.     MessagesEnabled := True;
  4674.     MessageToControls(GM_UPDATE_PREVIEW, 0, 0);
  4675.     MessageToControls(GM_PAPER_SIZE_CHANGED, 0, 0);
  4676.   end;
  4677. end;
  4678.  
  4679. procedure TGmPreview.SetPrintCopies(APrintCopies: integer);
  4680. begin
  4681.   if (APrintCopies <> FPrintCopies) and (APrintCopies > 0) then
  4682.     FPrintCopies := APrintCopies;
  4683. end;
  4684.  
  4685. procedure TGmPreview.SetPrinterBinIndex(AIndex: integer);
  4686. begin
  4687.   FPrinter.PrinterBinIndex := AIndex;
  4688. end;
  4689.  
  4690. procedure TGmPreview.SetPrinterIndex(AIndex: integer);
  4691. begin
  4692.   FPrinter.PrinterIndex := AIndex;
  4693. end;
  4694.  
  4695. procedure TGmPreview.SetPrintTitle(ATitle: string);
  4696. begin
  4697.   FPrinter.Title := ATitle;
  4698. end;
  4699.  
  4700. procedure TGmPreview.SetZoom(AZoom: integer);
  4701. var
  4702.   PercentX: Extended;
  4703.   PercentY: Extended;
  4704. begin
  4705.   if (AZoom > 0) then
  4706.   begin
  4707.     if Assigned(FOnZoom) then FOnZoom(Self, FZoom, AZoom);
  4708.     FZoom := AZoom;
  4709.  
  4710.     PercentX := 0;
  4711.     PercentY := 0;
  4712.  
  4713.     if HorzScrollBar.Position > 0 then
  4714.       PercentX := ((HorzScrollBar.Position) /(HorzScrollBar.Range-(ClientWidth))) * 100;
  4715.     if VertScrollBar.Position > 0 then
  4716.       PercentY := ((VertScrollBar.Position) /(VertScrollBar.Range-(ClientHeight))) *100;
  4717.  
  4718.     //F/PageImage.Visible := False;
  4719.     FPageImage.Scale := FZoom/100;
  4720.     MessageToControls(GM_UPDATE_PREVIEW, 0, 0);
  4721.     if HasParent then
  4722.       PositionPage;
  4723.     ScrollToPosition(PercentX, PercentY);
  4724.     //FPageImage.Visible := True;
  4725.   end;
  4726. end;
  4727.  
  4728. end.
  4729.